unit CheckThread;

{ Martin Harvey 30/5/2000 }

interface

uses
  Classes, Windows, ChecksumList, SysUtils;

type

  TState = (sGetCurrentCRCs,
    sBuildFileList,
    sRemoveCRCs,
    sCheckFile,
    sDone);

  TStateReturn = (rvOK, rvFail1, rvFail2);

  TActionFunc = function: TStateReturn of object;

  TStateActions = array[TState] of TActionFunc;

  TNextStates = array[TState, TStateReturn] of TState;

  TCheckThread = class(TThread)
  private
    FStartDir: string;
    FCurrentState: TState;
    FActionFuncs: TStateActions;
    FNextStates: TNextStates;
    FInternalFileList: TStringList;
    FExternalFileList: TStringList;
    FExternalCRCList: TStringList;
    FCheckList: TChecksumList;
    FFileToProcess: integer;
  protected
    procedure InitActionFuncs;
    procedure InitNextStates;
    function GetCurrentCRCs: TStateReturn;
    function BuildFileList: TStateReturn;
    function RemoveCRCs: TStateReturn;
    function CheckFile: TStateReturn;
    procedure Execute; override;
  public
    constructor Create(CreateSuspended: boolean);
    destructor Destroy; override;
    property StartDir: string read FStartDir write FStartDir;
    property CheckList: TChecksumList read FCheckList write FCheckList;
  end;

implementation

{ TCheckThread }

{(*} {Prettyprinter auto-formatting off}

const
  BaseStateTransitions:TNextStates = (
                      {rvOK}             {rvFail1}        {rvFail2}
{sGetCurrentCRCs } ( sBuildFileList,      sDone,           sDone ),
{sBuildFileList  } ( sRemoveCRCs,         sDone,           sDone ),
{sRemoveCRCs     } ( sCheckFile,          sDone,           sDone ),
{sCheckFile      } ( sCheckFile,          sGetCurrentCRCs, sDone ),
{sDone           } ( sDone,               sDone,           sDone ));

 {*)}{Prettyprinter auto-formatting on}

procedure TCheckThread.InitActionFuncs;
begin
  FActionFuncs[sGetCurrentCRCs] := GetCurrentCRCs;
  FActionFuncs[sBuildFileList] := BuildFileList;
  FActionFuncs[sRemoveCRCs] := RemoveCRCs;
  FActionFuncs[sCheckFile] := CheckFile;
end;

procedure TCheckThread.InitNextStates;
begin
  FNextStates := BaseStateTransitions;
end;

function TCheckThread.GetCurrentCRCs: TStateReturn;
begin
  FExternalFileList.Free;
  FExternalFileList := nil;
  FExternalCRCList.Free;
  FExternalCRCList := nil;

  FExternalFileList := FCheckList.GetFileList;
  FExternalCRCList := FCheckList.GetChecksumList;
  result := rvOK;
end;

function TCheckThread.BuildFileList: TStateReturn;

var
  FindRet: integer;
  SearchRec: TSearchRec;

begin
  FInternalFileList.Clear;
  FindRet := FindFirst(StartDir + '*.*', faAnyFile and not faDirectory, SearchRec);
  if FindRet <> 0 then
    result := rvFail1
  else
  begin
    while FindRet = 0 do
    begin
      { Found a file.}
      FInternalFileList.Add(SearchRec.Name);
      FindRet := FindNext(SearchRec);
    end;
    result := rvOK;
  end;
  FindClose(SearchRec);
  FFileToProcess := 0;
end;

function TCheckThread.RemoveCRCs: TStateReturn;

var
  iter: integer;
  dummy: integer;

begin
  FInternalFileList.Sort;
  FExternalFileList.Sort;
  if FExternalFileList.Count > 0 then
  begin
    for iter := 0 to FExternalFileList.Count - 1 do
    begin
      if not FInternalFileList.Find(FExternalFileList[iter], dummy) then
        FCheckList.RemoveChecksum(FExternalFileList[iter]);
    end;
  end;
  result := rvOK;

end;

function TCheckThread.CheckFile: TStateReturn;

var
  FileData: TFileStream;
  MemImage: TMemoryStream;
  Data: byte;
  Sum: integer;
  iter: integer;

begin
  if FFileToProcess >= FInternalFileList.Count then
  begin
    result := rvFail1;
    exit;
  end;
  Sum := 0;
  FileData := nil;
  MemImage := nil;
  try
    FileData := TFileStream.Create(StartDir + FInternalFileList[FFileToProcess],
      fmOpenRead or fmShareDenyWrite);
    FileData.Seek(0, soFromBeginning);
    MemImage := TMemoryStream.Create;
    MemImage.CopyFrom(FileData, FileData.Size);
    MemImage.Seek(0, soFromBeginning);
    for iter := 1 to FileData.Size do
    begin
      MemImage.ReadBuffer(Data, sizeof(Data));
      Inc(Sum, Data);
    end;
    FileData.Free;
    MemImage.Free;
    if (FCheckList.GetChecksum(FInternalFileList[FFileToProcess]) <> Sum) then
      FCheckList.SetChecksum(FInternalFileList[FFileTOProcess], Sum);
  except
    on EStreamError do
    begin
      FileData.Free;
      MemImage.Free;
    end;
  end;
  Inc(FFileToProcess);
  result := rvOK;
end;

procedure TCheckThread.Execute;
begin
  SetThreadPriority(Handle, THREAD_PRIORITY_IDLE);
  while not (Terminated or (FCurrentState = sDone)) do
    FCurrentState := FNextStates[FCurrentState, FActionFuncs[FCurrentState]];
end;

constructor TCheckThread.Create(CreateSuspended: boolean);
begin
  inherited Create(CreateSuspended);
  InitActionFuncs;
  InitNextStates;
  FInternalFileList := TStringList.Create;
end;

destructor TCheckThread.Destroy;
begin
  FInternalFileList.Free;
  FExternalFileList.Free;
  FExternalCRCList.Free;
  inherited Destroy;
end;

end.