База Firebird 2.0, метод доступа думаю в листинге увидите. Ошибка не знаю какая, это моя первая попытка написать многопоточное приложение и как смотреть ошибку в потоке я еще не знаю.
Постарался лишнее удалить. Так как несколько раз переделывал, то где то могут остаться хвосты от предыдущих вариантов.
это код основной программы:
| Код |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, JvExControls, JvAnimatedImage, JvGIFCtrl, ExtCtrls,
WinInet, IBDatabase, DB, IBCustomDataSet, IBQuery, inifiles;
type
TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
JvGIFAnimator1: TJvGIFAnimator;
Memo1: TMemo;
IBD: TIBDatabase;
IBTransaction1: TIBTransaction;
Button2: TButton;
IBTransaction2: TIBTransaction;
IBQuery1: TIBQuery;
IBQuery2: TIBQuery;
Label1: TLabel;
Image2: TImage;
JvGIFAnimator2: TJvGIFAnimator;
Read_Q: TIBQuery;
Label2: TLabel;
Edit1: TEdit;
Label3: TLabel;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
function GetDataI(SQL:String):Integer;
Procedure CreateTemplate;
Procedure updates(sss:string);
private
{ Private declarations }
public
num : array [0..9, 0..4, 0..14] of integer; // массив образов
IBQuerynovis: TIBQuery;
{ Public declarations }
end;
var
Form1: TForm1;
ini:Tinifile;
put:string;
CntThreads:integer;
implementation
{$R *.dfm}
uses uticTheard;
................................................
procedure TForm1.Button1Click(Sender: TObject);
var
s,url:string;
i:integer;
boo:boolean;
th:TTicThread;
begin
ibd.Connected:=true;
ibquery1.SQL.Add('select DOMENRU from TICKA where tic030310 is NULL');
ibquery1.Open;
i:=0;
SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_HIGHEST);
while not ibquery1.EOF do
begin
try
th := TTicThread.Create(true);
SetThreadPriority(th.ThreadID, THREAD_PRIORITY_HIGHEST);
th.Url := IBQuery1.fieldbyname('DOMENRU').AsString;
th.form := self;
th.Resume;
sleep(100);
Application.ProcessMessages;
sleep(100);
except
end;
ibquery1.Next;
end;
Inc(i);
//if i mod 100=0 then begin
Label1.Caption:=IntToSTR(i);
Application.ProcessMessages;
//end;
// ibquery1.Next;
//end;
ibquery1.Close;
ibd.Connected:=false;
end;
............................
end.
|
это код потока:
| Код |
unit uTicTheard;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, JvExControls, JvAnimatedImage, JvGIFCtrl, ExtCtrls,
WinInet, unit1,, IBDatabase, DB, IBCustomDataSet, IBQuery;
type
TTicThread = class(TThread)
protected
Procedure GetCY(xWidth, xHeight : integer; xBMP: TBitMap; var xNum : string);
Procedure GetCX(xWidth, xHeight : integer; xBMP,x2BMP: TBitMap; var flo : boolean);
function GetInetFile(const fileURL, FileName: String): boolean;
procedure Execute; override;
public
url:string;
form: TForm1;
end;
implementation
Procedure TTicThread.GetCY(xWidth, xHeight : integer; xBMP: TBitMap; var xNum : string);
begin
.........................
end;
Procedure TTicThread.GetCX(xWidth, xHeight : integer; xBMP,x2BMP: TBitMap; var flo : boolean);
begin
........................
end;
function TTicThread.GetInetFile(const fileURL, FileName: String): boolean;
begin
..............................
end;
procedure TTicThread.Execute;
var
s,ur:string;
JvGIFAnimator1:TJvGIFAnimator;
Image1,Image2: TImage;
boo:boolean;
IBDataBase:TIBDataBase;
IBTran:TIBTransaction;
IBTranDB:TIBTransaction;
IBQuery:TIBQuery;
begin
ur:=Copy(url,1,(Length(url)-4));
//если файл скачался
if GetInetFile('http://www.yandex.ru/cycounter?'+url,extractfilepath(paramstr(0))+ur+'.gif') = true then
begin
//тут загружаем файл в image и начинаем распознавать его
GetCX ( Image1.Picture.Bitmap.Width,
Image1.Picture.Bitmap.Height,
Image1.Picture.Bitmap,Image2.Picture.Bitmap,
boo);
if boo then
GetCY ( Image1.Picture.Bitmap.Width,
Image1.Picture.Bitmap.Height,
Image1.Picture.Bitmap,s)
else s:='0';
после распознования идет добавление в базу
try
IBDataBase:=TIBDataBase.Create(nil);
IBQuery:=TIBQuery.Create(nil);
IBTran:=TIBTransaction.Create(nil);
IBTranDB:=TIBTransaction.Create(nil);
IBDataBase.DatabaseName:='localhost:E:\Acronis\tictest.gdb';
IBDataBase.Params.Add('user_name=SYSDBA');
IBDataBase.Params.Add('PASSWORD=masterkey');
IBDataBase.Params.Add('lc_ctype=WIN1251');
IBDataBase.LoginPrompt:=false;
IBDataBase.DefaultTransaction:=IBTranDB;
IBTranDB.DefaultDatabase:=IBDataBase;
IBTran.DefaultDatabase:=IBDataBase;
IBQuery.database:=IBDataBase;
IbQuery.Transaction:=IbTran;
IBDataBase.Connected:=true;
IBQuery.SQL.Add('update TICKA set tic030310 = '+#39+s+#39+' where domenru = '+#39+url+#39);
IBQuery.ExecSQL;
IBQuery.Transaction.Commit;
IBQuery.Close;
IBQuery.Destroy;
IBTran.Destroy;
IBTranDB.Destroy;
IBDataBase.Destroy;
finally
//
end;
end;
Deletefile(extractfilepath(paramstr(0))+ur+'.gif');
inherited;
end;
end.
|
|
)