TThreade raise acccess violation error while running application in service mode

rajuksoni
rajuksoni used Ask the Experts™
on
I am having application that downloads/ uploads files from ftp server; it it uses indy10 ftp component with tthread; now the application runs fine in desktop mode; but while trying to run the application in service mode (becuase there are scheduled tasks in application);
It causes :Access violation at address 0042016B in module 'COPMailEngine.exe'. Read of address 00000008
- copmailengine is name of project
and all other functions of applications runs well except ftp job under tthread. It uses sendmessage() to update status of threade in main form
Please guide me what could be the reason
unit FTPJobsU;
 
interface
 
uses
  Contnrs,
  Messages,
  SysUtils,
  Windows,
  FTPU;
 
type
 
  TFtpJob = class
  private
    fPassN: integer;
  public
    JobID: string;
    HostName: string;
    FileName: string;
    UserName: string;
    Password: string;
    RemoteDir: string;
    TimeStamp: TDateTime;
    CheckTime: boolean;
    Download: boolean;
    UsePassive: boolean;
    SSL: boolean;
    SSLExplicit: boolean;
    UseDataPortProtection: boolean;
    JobStatus: integer; //0 - not running; 1- running; 2 - ended success; 3 - error
    ErrorMessage: string;
    FtpThread: TftpThread;
  end;
 
  TFTPJobs = class(TObjectList)
  private
    fMainFormHandle: HWND;
    procedure UpdateMainForm;
  public
    Retry: integer; //number of retries for each job in case of error
    RetryTimeout: integer; //retry timeout between jobs in sec.
    constructor Create(MainFormHandle: HWND);
    procedure AbortAllJobs;
    procedure AbortFTPJob(aJobID: string);
    procedure AddFTPJob(const aHostName, aFileName, aUserName, aPassword,
        aRemoteDir, aJobID: string; aTimeStamp: TDateTime;
        aCheckTime, aDownload, aUsePassive, aSSL, aSSLExplicit,
        aUseDataPortProtection: boolean);
    function CheckIfRunning: boolean;
    function FindFTPJob(aJobID: string): integer;
    procedure FTPThreadOnTerminate(Sender: TObject);
    procedure RunFTPJob(aJobID: string);
  end;
 
const
  WMJobsUpdate = WM_USER + 1;
 
implementation
 
uses
  Dialogs;
 
{ TFTPJobs }
 
procedure TFTPJobs.AbortAllJobs;
var
  i: integer;
  FTPJob: TFTPJob;
begin
  for i := 0 to Count - 1 do
  begin
    FTPJob := TFTPJob(Items[i]);
    AbortFTPJob(FTPJob.JobID);
  end;
end;
 
procedure TFTPJobs.AbortFTPJob(aJobID: string);
var
  Index: integer;
begin
  Index := FindFTPJob(aJobID);
  if Index < 0 then
    raise Exception.CreateFmt('Job %s is not found in the list.', [aJobID]);
  with TFtpJob(Items[Index]) do
  begin
    if JobStatus <> 1 then
      Exit;
    FtpThread.Terminate;
  end;
end;
 
procedure TFTPJobs.AddFTPJob(const aHostName, aFileName, aUserName,
  aPassword, aRemoteDir, aJobID: string; aTimeStamp: TDateTime; aCheckTime,
  aDownload, aUsePassive, aSSL, aSSLExplicit,
  aUseDataPortProtection: boolean);
var
  FTPJob: TFTPJob;
begin
  FTPJob := TFTPJob.Create;
  Add(FTPJob);
  with FTPJob do
  begin
    JobStatus := 0;
    fPassN := 0;
    FTPThread := nil;
    JobID := aJobID;
    HostName := aHostName;
    FileName := aFileName;
    UserName := aUserName;
    Password := aPassword;
    RemoteDir := aRemoteDir;
    TimeStamp := aTimeStamp;
    CheckTime := aCheckTime;
    Download := aDownload;
    UsePassive := aUsePassive;
    SSL := aSSL;
    SSLExplicit := aSSLExplicit;
    UseDataPortProtection := aUseDataPortProtection;
  end;
  UpdateMainForm;
end;
 
constructor TFTPJobs.Create(MainFormHandle: HWND);
begin
  inherited Create(True);
  fMainFormHandle := MainFormHandle;
  Retry := 1; //no retry by default
  RetryTimeout := 0;
end;
 
function TFTPJobs.CheckIfRunning: boolean;
var
  Index: integer;
begin
  Result := False;
  for Index := 0 to Count - 1 do
  begin
    if TFtpJob(Items[Index]).JobStatus = 1 then
    begin
      Result := True;
      break;
    end;
  end;
end;
 
function TFTPJobs.FindFTPJob(aJobID: string): integer;
var
  i: integer;
begin
  Result := -1;
  for i := 0 to Count - 1 do
  begin
    if TFtpJob(Items[i]).JobID = aJobID then
    begin
      Result := i;
      break;
    end;
  end;
 
end;
 
 
procedure TFTPJobs.FTPThreadOnTerminate(Sender: TObject);
var
  Index: integer;
begin
  try
    Index := FindFTPJob((Sender as TftpThread).JobId);
    if Index < 0 then
      Exit;
    with TFtpJob(Items[Index]) do
    begin
      if (Sender as TftpThread).FatalException <> nil then
      begin
        ErrorMessage := Exception((Sender as TftpThread).FatalException).Message;
        JobStatus := 3;
      end else
      begin
        ErrorMessage := '';
        JobStatus := 2;
      end;
      FtpThread := nil;
      if (JobStatus = 3) and (fPassN < Retry) then
      begin
        Inc(fPassN);
        FtpThread := TftpThread.Create(HostName, FileName, UserName, Password,
          RemoteDir, JobID, TimeStamp, CheckTime, Download, UsePassive, SSL,
          SSLExplicit, UseDataPortProtection, nil, RetryTimeout);
        FtpThread.OnTerminate := FTPThreadOnTerminate;
        JobStatus := 1; //running
        Inc(fPassN);
        FtpThread.Resume;
      end;
    end;
    UpdateMainForm;
  except
    on E: Exception do
    begin
      // no exceptions in OnTerminate
      ShowMessage(E.Message);
    end;
  end;
end;
 
procedure TFTPJobs.RunFTPJob(aJobID: string);
var
  Index: integer;
begin
  Index := FindFTPJob(aJobID);
  if Index < 0 then
    raise Exception.CreateFmt('Job %s is not found in the list.', [aJobID]);
  with TFtpJob(Items[Index]) do
  begin
    if JobStatus <> 0 then
      Exit;
    FtpThread := TftpThread.Create(HostName, FileName, UserName, Password,
      RemoteDir, JobID, TimeStamp, CheckTime, Download, UsePassive, SSL,
      SSLExplicit, UseDataPortProtection, nil, 0);
    FtpThread.OnTerminate := FTPThreadOnTerminate;
    JobStatus := 1; //running
    Inc(fPassN);
    FtpThread.Resume;
  end;
  UpdateMainForm;
end;
 
 
procedure TFTPJobs.UpdateMainForm;
begin
  SendMessage(fMainFormHandle, WMJobsUpdate, 0, 0);
end;
 
end.

Open in new window

Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Propably it has to do something with the handle of the mainform since (and correct if i am wrong) a service does not have a main form and TApplication is a completely different component.
So you must write the update procedure to be more generic and not depended on a handle of a form.
TApplication is a completely different component from TServiceApplication
read the help or the SvcMg unit to see more...

Author

Commented:
Hi
We are not getting error at constructor where mainformhandle is accessed; but at
TFTPJobs.AddFTPJob() so please let me know if anything wrong with this method
Amazon Web Services

Are you thinking about creating an Amazon Web Services account for your business? Not sure where to start? In this course you’ll get an overview of the history of AWS and take a tour of their user interface.

Oracle dba
Top Expert 2009
Commented:
did you set interactive ?

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  Service1.Controller(CtrlCode);
  Service1.Interactive := True;
end;

the problem is not with the FtpJob, but indeed with sendmessage to the main form
there is indeed no mainform

the code you posted is not the essence of your problem, it's the rest
how are you calling this code (from a form or from the ServiceThread ?)

you should be aware that a service app is something run in the background (no forms)

this will cause the same problem:
  except
    on E: Exception do
    begin
      // no exceptions in OnTerminate
      ShowMessage(E.Message);  <=== this will cause an error too (no forms, remember ?)
    end;
  end;

you should instead log all problems to files.
not on the screen

MerijnBSr. Software Engineer

Commented:
Install (the free trial of) Eurekalog, it will show you the exact place in code where the error occurs: www.eurekalog.com
Mike McCrackenSenior Consultant
Most Valuable Expert 2011
Top Expert 2013

Commented:
This question has been classified as abandoned and is being closed as part of the Cleanup Program.  See my comment at the end of the question for more details.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial