Link to home
Start Free TrialLog in
Avatar of makitoo
makitoo

asked on

using threads

can someone givme a simple example of using thread, please show me some code. thanks
Avatar of trabzone
trabzone

first
file / new / thread
create a thread

then

unit DirThread;

interface

uses
  Windows, Classes;

type
  TDir = class(TThread)
  private
    FNotificationBuffer: array[0..4096] of Byte;
    FCompletionPort: THandle;
    FOverlapped: TOverlapped;
    FPOverlapped: POverlapped;
    FBytesWritten: DWORD;
    FDirectoryHandle: THandle;
    FNotifyFilter: DWORD;
    procedure HandleEvent;
  protected
    procedure Execute; override;
  public
    constructor Create;
  end;

type
  PFileNotifyInformation = ^TFileNotifyInformation;
  TFileNotifyInformation = record
    NextEntryOffset: DWORD;
    Action: DWORD;
    FileNameLength: DWORD;
    FileName: array[0..0] of WideChar;
  end;

const
  SAction: array[FILE_ACTION_ADDED..FILE_ACTION_RENAMED_NEW_NAME] of String =
   ( 'ADDED %s', 'DELETED %s', 'MODIFIED %s', 'RENAMED %s [...]', '[...] into %s');
  FILE_LIST_DIRECTORY   = $0001;


implementation

constructor TDir.Create;
begin
  inherited Create(True);
  FCompletionPort := 0;
  FPOverlapped := @FOverlapped;
  ZeroMemory(@FOverlapped, SizeOf(FOverlapped));
  FNotifyFilter := 0;
  FNotifyFilter := FILE_NOTIFY_CHANGE_FILE_NAME or FILE_NOTIFY_CHANGE_DIR_NAME
  or FILE_NOTIFY_CHANGE_ATTRIBUTES or FILE_NOTIFY_CHANGE_SIZE or FILE_NOTIFY_CHANGE_LAST_WRITE
  or FILE_NOTIFY_CHANGE_LAST_ACCESS or FILE_NOTIFY_CHANGE_CREATION or FILE_NOTIFY_CHANGE_SECURITY;
  if FNotifyFilter = 0 then
  begin
     //warning here
  end;
  FDirectoryHandle := CreateFile(PChar('C:\'),FILE_LIST_DIRECTORY, FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE,
    nil,OPEN_EXISTING,FILE_FLAG_BACKUP_SEMANTICS or FILE_FLAG_OVERLAPPED,0);
  if FDirectoryHandle = INVALID_HANDLE_VALUE then
  begin
    FDirectoryHandle := 0;
    //ShowMessage(SysErrorMessage(GetLastError));
    exit;
  end;
  FCompletionPort := CreateIoCompletionPort(FDirectoryHandle, 0, Longint(pointer(self)), 0);
  ZeroMemory(@FNotificationBuffer, SizeOf(FNotificationBuffer));
  FBytesWritten := 0;
  if not ReadDirectoryChanges(FDirectoryHandle, @FNotificationBuffer, SizeOf(FNotificationBuffer), true, FNotifyFilter, @FBytesWritten, @FOverlapped, nil) then
  begin
    CloseHandle(FDirectoryHandle);
    FDirectoryHandle := 0;
    CloseHandle(FCompletionPort);
    FCompletionPort := 0;
    //ShowMessage(SysErrorMessage(GetLastError));
    exit;
  end;
  FreeOnTerminate := False;
end;

procedure TDir.HandleEvent;
var
  FileOpNotification: PFileNotifyInformation;
  Offset: Longint;
begin
  Pointer(FileOpNotification) := @FNotificationBuffer[0];
  repeat
    Offset := FileOpNotification^.NextEntryOffset;
    PChar(FileOpNotification) := PChar(FileOpNotification)+Offset;
  until Offset=0;
end;

procedure TDir.Execute;
var
  numBytes: DWORD;
  CompletionKey: DWORD;
begin
  while not Terminated do
  begin
    GetQueuedCompletionStatus( FCompletionPort, numBytes, CompletionKey, FPOverlapped, INFINITE);
    if CompletionKey <> 0 then
    begin
      Synchronize(HandleEvent);
      FBytesWritten := 0;
      ZeroMemory(@FNotificationBuffer, SizeOf(FNotificationBuffer));
      ReadDirectoryChanges(FDirectoryHandle, @FNotificationBuffer, SizeOf(FNotificationBuffer), true, FNotifyFilter, @FBytesWritten, @FOverlapped, nil);
    end
    else
      Terminate;
  end;
end;

end.

this thread is for monitoring directory changes.
Use "Synchronize" to change anything on form. To use, first create a function (for example func1 )then write
synchronize(func1);
anywhere in thread unit...

then to use this thread use these codes

var
 diract          : TDir;

procedure ThreadSonu;
begin
  //write here what you want when thread finishes


diract:=TDir.Create;
  diract.OnTerminate:=ThreadSonu;
  TDir(diract).Resume;
if it is so complex then try ro look only to the function names then you can understand how thread works...
Avatar of makitoo

ASKER

yes its a bit complex. My problem is my app does a process that sometimes takes 4-9 min to complete, in the meantime the app stops responding. do I need to use threads or is there other way to fix this problem?
Avatar of Lukasz Zielinski
if its only one procedure /function thats takes 4-9 mins and there doesnt share any resources then CreateThread)nil,0,@procedure,nil,0,@ThID) will be enough for You.
ziolko.
You can use one thread to do so yes (look in the directory c:\Program files\Borland\Delphi x\Demos\Threads for a simple example. Using thread might do a cleaner job.

But if you don't want your user to be able to do anything while this is going on (this sometimes happens), you might just add a:

  Application.ProcessMessages;

In your loop which will avoid the "freezed" look. But I said, thread might be cleaner.

Here is a quick example, hope it helps!

type
  TYourThread = class(TThread)
  private
    // Variables for your thread only
    Max: Integer;
    procedure ShowInLabel;
  protected
    procedure Execute; override;
  public
    constructor Create(A: Integer);
  end;

constructor TYourThread.Create(A: Integer);
begin
  Max := A;
  FreeOnTerminate := True;
  inherited Create(False);
end;

// When working with VCL (whatever graphical most of the time)
//  use the Synchronize method... see later
procedure TYourThread.ShowInLabel;
begin
  with Label1 do
  begin
    Caption := IntToStr(Max);
  end;
end;

procedure TYourThread.Execute;
begin
  // Do your treatment here or call procedures or whatever
  Inc(Max);
  // If you want to use the VCL, to show the results for example, use synchronize
  Synchronize(ShowInLabel);
end;


Any questions?
change the priority of the thread
i cannot remember the codes but if you look to the help
help/ TThread / priority

u can find the solution
you may use real_time_priority
Oops, writing while ziolko did.

His trick might do the trick for you yes. It is quite good if you only have a simple procedure.

But you still have an easy example for threads if you want to learn ;-). You can create multiple thread like that.

Oh, forget to tell you how to call the thread:

var
  ThreadsRunning: Integer;

procedure TThreadForm.StartBtnClick(Sender: TObject);
begin
  // This is just to keep track of how much threads are running
  ThreadsRunning := 1;
  // You pass a max or whatever for our fake function
  with TYourThread.Create(8) do
    // This is to do something when thread is done
    OnTerminate := ThreadDone;
  // Do you disable some buttons??
end;

procedure TThreadForm.ThreadDone(Sender: TObject);
begin
  Dec(ThreadsRunning); // We calculate how much threads are running now
  if ThreadsRunning = 0 then
  begin
    // No more threads running? Is it time to
    //  put some buttons enabled back?
  end;
end;
Avatar of makitoo

ASKER

ziolko: where do I put that? is that the only code nedded?

Yes my problem is the "ugly freeze" I dont need to do other process and the user must wait until it finishes.
Just add an Application.ProcessMessages in your loop. The end of it. Nothing will move in your thread (your program) but visual messages will continue to flow in so no buttons disapearing or things like that!
For example, if you are stuck in a big loop:

for I := 0 to 1000000 do begin
  // Some lengthy stuff
  Application.ProcessMessages;
end;

Or a long procedure

begin
  // Long process ...
  Application.ProcessMessages;
  // Long process ...
  Application.ProcessMessages;
  // Long process ...
end;
Avatar of makitoo

ASKER

loop_until :  the Application.ProcessMessages; did the job the only problem now is that the user can click and mess around. What can I do to disable everithing, I have everithing on tabcontrol with 3 tabsheets...
Put your TabControl.Enabled := False before and TabControl.Enabled := True after :-).

Should do the trick.
Avatar of makitoo

ASKER

is there other way? I want to leave a cancel button in case user wants to cancel ( I still dont know how to cancel the loop, do you know how to interupt a running repeat-until from an external button?)
ASKER CERTIFIED SOLUTION
Avatar of loop_until
loop_until

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Or

repeat
  // ...
until (NormalCondition and not(DidCancel));
Avatar of makitoo

ASKER

Thanks man, you have been great help. Thanks again.
No problem! Glas it helped and thanks for the points.

You could look anyway the other tips given here as there are useful too (such as trabzone and ziolko code and the little thread code I gave you before too).

Have a nice day makitoo!
hmmm yesterday I went sleep and today problem solved... not lucky again.
ziolko.