Help creating a service.

I have added a question :
http://www.experts-exchange.com/jsp/qManageQuestion.jsp?ta=delphi&qid=20303736

I don't think that it should be so hard but I didn't got any complete answer.

What I like to do is to create backups of a file if it has been changed.

For exaple say the file
c:\test.tmp

When the service starts I like to make a copy of c:\test.tmp
into

c:\tmp\2002-07-06\10-02-11.tmp

where '2002-07-06 is the current date
and 10-02-11 is the current time. (10:02:54)

then I want the service to check every 10 minute if
the file c:\test.tmp has been changed since the last backup. if so I like to make a new copy
(with a correct name in the same way as before.)

If possible I like to have it that way that the file is not locked for other programs during the copy.

Can someone help me out with this.

LVL 2
wqclatreAsked:
Who is Participating?
 
geobulConnect With a Mentor Commented:
It'd be better to rewrite CopyFile procedure in order to skip raising exceptions. If an exception occurs then the file will NOT be copied.

procedure CopyFile(const FileName, DestName: TFileName);
var
 CopyBuffer: Pointer; { buffer for copying }
 BytesCopied: Longint;
 Source, Dest: Integer; { handles }
 Destination: TFileName; { holder for expanded destination name }
const
 ChunkSize: Longint = 8192; { copy in 8K chunks }
begin
 Destination := ExpandFileName(DestName);  { expand the destination path }
 GetMem(CopyBuffer, ChunkSize); { allocate the buffer }
 try
  try
   Source := FileOpen(FileName, fmOpenRead or fmShareDenyNone); { open source file }
   if not (Source < 0) then begin
    try
     Dest := FileCreate(Destination); { create output file; overwrite existing }
     if not (Dest < 0) then begin
      try
       repeat
         BytesCopied := FileRead(Source, CopyBuffer^, ChunkSize); { read chunk }
         if BytesCopied > 0 then { if we read anything... }
           FileWrite(Dest, CopyBuffer^, BytesCopied); { ...write chunk }
       until BytesCopied < ChunkSize; { until we run out of chunks }
      finally
       FileClose(Dest); { close the destination file }
      end;
     end;
    finally
     FileClose(Source); { close the source file }
    end;
   end;
  finally
    FreeMem(CopyBuffer, ChunkSize); { free the buffer }
  end;
 except
   // do nothing
 end;
end;
0
 
TOndrejCommented:
What do you need help with?
0
 
deansmithCommented:
hi,

I think you need to be more specfic here. Do you want someone to create the service for you or do you want to know how to create a service.

Have you also considered that you will be creating a backup every 10 minutes, 6 backups an hour and 144 backups a day. depending on the size of the file you could run out of disk space very soon. CAn you describe what you are trying to achieve because there maybe a better way.

What is being stored in the test.tmp file?


Dean


0
Introducing Cloud Class® training courses

Tech changes fast. You can learn faster. That’s why we’re bringing professional training courses to Experts Exchange. With a subscription, you can access all the Cloud Class® courses to expand your education, prep for certifications, and get top-notch instructions.

 
wqclatreAuthor Commented:
Yes. But I only want to back it up if the file has been changed. And I guess it would not be changed so often.

I think I understand how to create a service (or can figure out) But help with this would be greateful to.

THe thing I can't understand is how to make copy of the file.. how to se if the file has changed. how to create those directories etc etc,.,.

0
 
wqclatreAuthor Commented:
the test.tmp file could be anything.
for example a copy of the icq database the seems to get broken for me every now and then....
0
 
geobulCommented:
Hi,
Using 'File-New-Service Application' create a new app, drop a timer, set its interval to 600000 (10 min) and use the code below.

Save and build the app. Using 'Start button-Run' execute:
path\exename.exe /install
You will see something like: Service was installed successfully

Open the 'services' window, select your service, make it logon on system account and start it.

Regards, Geo
-----
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Consts, Graphics, Controls, SvcMgr, Dialogs,
  ExtCtrls;

type
  TGeoService = class(TService)
    Timer1: TTimer;
    procedure ServiceExecute(Sender: TService);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    function GetServiceController: TServiceController; override;
    { Public declarations }
  end;

var
  GeoService: TGeoService;
  MyFileName: string;
  LastTime, NewTime: TDateTime;

implementation

{$R *.DFM}

uses FileCtrl, ShellApi;

function HasAttr(const FileName: string; Attr: Word): Boolean;
begin
  Result := (FileGetAttr(FileName) and Attr) = Attr;
end;

procedure CopyFile(const FileName, DestName: TFileName);
var
  CopyBuffer: Pointer; { buffer for copying }
  BytesCopied: Longint;
  Source, Dest: Integer; { handles }
  Destination: TFileName; { holder for expanded destination name }
const
  ChunkSize: Longint = 8192; { copy in 8K chunks }
begin
  Destination := ExpandFileName(DestName);  { expand the destination path }
  GetMem(CopyBuffer, ChunkSize); { allocate the buffer }
  try
    Source := FileOpen(FileName, fmOpenRead or fmShareDenyNone); { open source file }
    if Source < 0 then raise EFOpenError.CreateFmt(SFOpenError, [FileName]);
    try
      Dest := FileCreate(Destination); { create output file; overwrite existing }
      if Dest < 0 then raise EFCreateError.CreateFmt(SFCreateError, [Destination]);
      try
        repeat
          BytesCopied := FileRead(Source, CopyBuffer^, ChunkSize); { read chunk }
          if BytesCopied > 0 then { if we read anything... }
            FileWrite(Dest, CopyBuffer^, BytesCopied); { ...write chunk }
        until BytesCopied < ChunkSize; { until we run out of chunks }
      finally
        FileClose(Dest); { close the destination file }
      end;
    finally
      FileClose(Source); { close the source file }
    end;
  finally
    FreeMem(CopyBuffer, ChunkSize); { free the buffer }
  end;
end;

function GetFileTimes(const filename: string; var Modified: TDateTime): boolean;
var sr:TSearchRec;
   SysTimeStruct: TSystemTime;
   lft: TFileTime;
begin
 Result:=False;
 if FindFirst(FileName,faAnyFile,sr) = 0 then
 begin
   if FileTimeToLocalFileTime(sr.FindData.ftLastWriteTime, lft) and
      FileTimeToSystemTime(lft, SysTimeStruct) then
      Modified := SystemTimeToDateTime(SysTimeStruct);
   FindClose(sr);
   Result:=True;
 end;
end;

function CopyMyFile: boolean;
var
  NewDir, NewFile: string;
begin
  result := true;
  try
    NewDir := 'c:\tmp\'+ FormatDateTime('yyyy-mm-dd',NewTime);
    NewFile := NewDir + '\' + FormatDateTime('hh-nn-ss',NewTime) + '.tmp';
    ForceDirectories(NewDir);
    if DirectoryExists(NewDir) then begin
      if not FileExists(NewFile) then begin
        CopyFile(MyFileName, NewFile);
      end;
    end;
  except
    result := false;
  end;
end;

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  GeoService.Controller(CtrlCode);
end;

function TGeoService.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;

procedure TGeoService.ServiceExecute(Sender: TService);
begin
  // first copy
  MyFileName := 'c:\test.tmp';
  if GetFileTimes(MyFileName, LastTime) then begin
    NewTime := LastTime;
    CopyMyFile;
  end;
  while not Terminated do begin
    ServiceThread.ProcessRequests(False);
  end;
end;

procedure TGeoService.Timer1Timer(Sender: TObject);
begin
  if GetFileTimes(MyFileName, NewTime) then begin
    if NewTime <> LastTime then begin
      CopyMyFile;
      LastTime := NewTime;
    end;
  end;
end;

end.
0
 
wqclatreAuthor Commented:
I get

Undeclared Identifier SFOpenError on row 50:

   if Source < 0 then raise EFOpenError.CreateFmt(SFOpenError, [FileName]);
0
 
geobulCommented:
add Consts to your uses clause. It's declared there.
0
 
wqclatreAuthor Commented:
Hm strange.

I have:

Uses
 Windows, Messages, SysUtils, Classes, Consts, Graphics, Controls, SvcMgr, Dialogs,
 ExtCtrls;

type....

I can't find SFOpenError in this unit either.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.