Форум: "Основная";
Текущий архив: 2003.03.20;
Скачать: [xml.tar.bz2];
Вниз
Многопроцессная прога Найти похожие ветки
← →
Vasechkin (2003-03-08 13:34) [0]Как сделать вот эту прогу многопроцессной?
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls, Psock, Gauges, winsock, Wininet, FileCtrl, ShellAPI,
NMsmtp, OnlineIP;
type
TForm1 = class(TForm)
GroupBox1: TGroupBox;
ListBox1: TListBox;
GroupBox2: TGroupBox;
GroupBox3: TGroupBox;
ListBox2: TListBox;
ListBox3: TListBox;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
GroupBox4: TGroupBox;
Gauge1: TGauge;
Button1: TButton;
SaveDialog1: TSaveDialog;
SaveDialog2: TSaveDialog;
Button6: TButton;
Label1: TLabel;
Label2: TLabel;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormCanResize(Sender: TObject; var NewWidth,
NewHeight: Integer; var Resize: Boolean);
procedure Button2Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
const
Fileip = "ip.txt";
implementation
uses Unit2;
{$R *.DFM}
function InInternet : boolean;//функция пинга
Var
i : integer;
S : string;
WSAData: TWSAData;
Host : PHostEnt;
begin
result:=false;
S := "www.rambler.ru";
i:=pos("http://", S); if i>0 then delete(S, 1, 7);
i:=pos("/", S); if i>0 then delete(S, i, 255);
if WSAStartup($101, WSAData) = 0 then
begin
Host := GetHostByName(@S[1]);
result := Host<>nil;
WSACleanUp;
end;
if not result then begin
S:="www.microsoft.com";
if WSAStartup($101, WSAData) = 0 then
begin
Host := GetHostByName(@S[1]);
result := Host<>nil;
WSACleanUp;
end;
end;
end;
function GetInetFile
(const fileURL, FileName: String): boolean;
const BufferSize = 1024;
var
hSession, hURL: HInternet;
Buffer: array[1..BufferSize] of Byte;
BufferLen: DWORD;
f: File;
sAppName: string;
begin
Result:=False;
sAppName := ExtractFileName(Application.ExeName);
hSession := InternetOpen(PChar(sAppName),
INTERNET_OPEN_TYPE_PRECONFIG,
nil, nil, 0);
try
hURL := InternetOpenURL(hSession,
PChar(fileURL),
nil,0,0,0);
try
AssignFile(f, FileName);
Rewrite(f,1);
repeat
InternetReadFile(hURL, @Buffer,
SizeOf(Buffer), BufferLen);
BlockWrite(f, Buffer, BufferLen)
until BufferLen = 0;
CloseFile(f);
Result:=True;
finally
InternetCloseHandle(hURL)
end
finally
InternetCloseHandle(hSession)
end
end;
procedure TForm1.Button1Click(Sender: TObject);
var
counter : integer;
F : TextFile;
S: String;
i, b : integer;
FileOnNet, LocalFileName, IP:String;
begin
if InInternet then begin
Gauge1.MinValue:=0;
Gauge1.MaxValue:=ListBox1.Items.Count-1;
For b:=1 to ListBox1.items.Count Do
begin
Gauge1.Progress:=Gauge1.Progress+1;
FileOnNet:=" http://www.mob.net/~ted/tools/rbl.php3?domain="+ListBox1.Items[b-1];
LocalFileName:=ListBox1.Items[b-1]+".html";
IP:=ListBox1.Items[b-1];
if GetInetFile(FileOnNet,LocalFileName)=True then
begin
Counter:=0;
AssignFile(F, LocalFileName);
Reset(F);
While not EOF(F) Do Begin
Readln(f,s);
Repeat
i:=Pos("BLOCKED",s);
if i<>0 then
Begin
Delete(s,i,Length("BLOCKED"));
inc(Counter);
End;
Until i=0;
End;
if Counter<3 then begin
ListBox2.Items.Add(IP);
CloseFile(F);
DeleteFile(LocalFileName);
end
else begin
ListBox3.Items.Add(IP);
CloseFile(F);
DeleteFile(LocalFileName);
End;
end
else begin
ShowMessage("Error in ip cheking")
end;
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
if not FileExists("ip.txt") then
ShowMessage("Файл со списком адресов ip.txt не существует. Создайте его.")
else begin
ListBox1.Clear;
ListBox1.Items.LoadFromFile(Fileip);
end;
end;
end.
← →
Романов Р.В. (2003-03-08 13:46) [1]Делай ее многопоточной, а процессоры сами между собой разберуться что кому выполнять.
← →
Vasechkin (2003-03-08 23:55) [2]Так я и спрашиваю как сделать ее многопоточной
← →
Palladin (2003-03-09 01:05) [3]
> Vasechkin © (08.03.03 23:55)
нет ты спрашиваешь как сделать ее многопроцессорной...
а что бы много поточной, открой из папки с примерами делфи Threads, там есть пример создания нескольких потоков... очень хороший между прочим
← →
Vasechkin (2003-03-09 14:33) [4]Так я там ничего и не понял. Подскажте как именно эту прогу сделать многопоточной
← →
Snap (2003-03-09 14:35) [5]Самое лучшее объяснение- кодом, а оно есть в Дельфи. Прочти его ещё раз.
← →
Palladin (2003-03-09 14:50) [6]
> Vasechkin © (09.03.03 14:33)
не понял - значит не дано
← →
Vasechkin (2003-03-09 19:33) [7]Так я прочел и ни х не понял.
← →
Palladin (2003-03-09 20:31) [8]
> Vasechkin © (09.03.03 19:33)
дорастешь до чтения кода или хотя бы до чтения хелпа, тогда и за потоки берись...
или жди пока ктонибудь сердобольный (и терпеливый настолько чтобы перелопатить сунутый тобой сюда код) напишет тебе как это сделать...
← →
Vasechkin (2003-03-09 20:56) [9]Я все читал. Но на пальцах объяснить же могут многие.
← →
ZmeiGorin (2003-03-09 21:09) [10]Многим лень :-)
Идеология такая:
Создаёшь потомка TThread
Пишешь ему метод Execute-то, где прога будет делать что-то полезное. Оформляешь как цикл, периодически проверяешь на terminated. Если true, то выходишь.
Для общения с VCL используй Syncronize.
Там, где надо создаёшь поток и работаешь с ним как с обычным объектом.
← →
Palladin (2003-03-09 21:13) [11]
> ZmeiGorin © (09.03.03 21:09)
у меня такие подозрения, что сейчас будет вопрос как создать потомка TThread...
← →
Makhanev A.S. (2003-03-09 21:59) [12]
> Vasechkin © (08.03.03 13:34)
Анкета у тебя интересная...
Лучше всё-таки книжки почитай на тему потоков, прежде чем help и code юзать. В книжках а примеры сразу идут....
Вдруг тебе где-нить понадобится потоки синхронизировать, тут уже "на пальцах" всего не опишешь.
В книгах на эту тему читал?
← →
Vasechkin (2003-03-09 22:29) [13]Нету книг. Я делфи то неделю юзаю
← →
Palladin (2003-03-09 22:38) [14]и уже за потоки...
← →
Vasechkin (2003-03-10 11:19) [15]Так попросили
← →
NDeu (2003-03-10 14:36) [16]
> Vasechkin © (10.03.03 11:19)
> Так попросили
Скажи НЕТ! Не буду :)
← →
sniknik (2003-03-10 17:02) [17]посмотри сюда
http://gurin.tomsknet.ru/technology.html
библиотека Gala, можеш не использовать но описание почитай обязательно, самое простое описание потоков что я видел. если и там не поймеш считай не судьба, пока.
← →
Vasechkin (2003-03-10 18:07) [18]Пасибки
Страницы: 1 вся ветка
Форум: "Основная";
Текущий архив: 2003.03.20;
Скачать: [xml.tar.bz2];
Память: 0.5 MB
Время: 0.009 c
