Fully rewritten for Lazarus. Has no backward compatibility with Delphi XE4 now. Now it can be compiled for Windows/Linux/MacOSX.
This commit is contained in:
meffi@lab313.ru
239
uscanthread.pas
Normal file
239
uscanthread.pas
Normal file
@@ -0,0 +1,239 @@
|
||||
unit uscanthread;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
ucommon, utim, uscanresult, classes, fgl;
|
||||
|
||||
type
|
||||
TScanThread = class(TThread)
|
||||
private
|
||||
{ Private declarations }
|
||||
pScanResult: TScanResult;
|
||||
pFileSize: Integer;
|
||||
pFilePos: Integer;
|
||||
pStatusText: string;
|
||||
pClearBufferPosition: Integer;
|
||||
pClearBufferSize: Integer;
|
||||
pSectorBufferSize: Integer;
|
||||
pSrcFileStream: TFileStream;
|
||||
pStopScan: boolean;
|
||||
procedure SetStatusText;
|
||||
procedure StartScan;
|
||||
procedure FinishScan;
|
||||
procedure UpdateProgressBar;
|
||||
procedure AddResult(TIM: PTIM);
|
||||
procedure ClearSectorBuffer(SectorBuffer, ClearBuffer: PBytesArray);
|
||||
protected
|
||||
procedure Execute; override;
|
||||
public
|
||||
constructor Create(const FileToScan: string; ImageScan: boolean);
|
||||
//property Started: boolean read pStarted write pStarted;
|
||||
property StopScan: boolean read pStopScan write pStopScan;
|
||||
end;
|
||||
TScanThreadList = specialize TFPGObjectList<TScanThread>;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
umain, ucdimage, sysutils, FileUtil;
|
||||
|
||||
const
|
||||
cClearBufferSize = ((cTIMMaxSize div cSectorDataSize) + 1) *
|
||||
cSectorDataSize * 2;
|
||||
cSectorBufferSize = (cClearBufferSize div cSectorDataSize) * cSectorSize;
|
||||
|
||||
{ TScanThread }
|
||||
|
||||
constructor TScanThread.Create(const FileToScan: string; ImageScan: boolean);
|
||||
begin
|
||||
inherited Create(True);
|
||||
FreeOnTerminate := True;
|
||||
pClearBufferPosition := 0;
|
||||
pFilePos := 0;
|
||||
pFileSize := FileSize(FileToScan);
|
||||
pStatusText := '';
|
||||
pStopScan := False;
|
||||
|
||||
pScanResult := TScanResult.Create;
|
||||
pScanResult.ScanFile := FileToScan;
|
||||
pScanResult.IsImage := ImageScan;
|
||||
end;
|
||||
|
||||
procedure TScanThread.AddResult(TIM: PTIM);
|
||||
var
|
||||
ScanTim: TTimInfo;
|
||||
begin
|
||||
ScanTim.Position := TIM^.dwTimPosition;
|
||||
ScanTim.Size := TIM^.dwSIZE;
|
||||
ScanTim.Width := GetTimRealWidth(TIM);
|
||||
ScanTim.Height := GetTimHeight(TIM);
|
||||
ScanTim.Bitmode := BppToBitMode(TIM);
|
||||
|
||||
if TIMHasCLUT(TIM) then
|
||||
ScanTim.Cluts := GetTimClutsCount(TIM)
|
||||
else
|
||||
ScanTim.Cluts := 0;
|
||||
|
||||
ScanTim.Good := TIMIsGood(TIM);
|
||||
|
||||
pScanResult.Count := TIM^.dwTimNumber;
|
||||
pScanResult.ScanTim[pScanResult.Count - 1] := ScanTim;
|
||||
end;
|
||||
|
||||
procedure TScanThread.Execute;
|
||||
var
|
||||
SectorBuffer, ClearBuffer: PBytesArray;
|
||||
TIM: PTIM;
|
||||
pScanFinished: boolean;
|
||||
pRealBufSize, pTimPosition, pTIMNumber: Integer;
|
||||
begin
|
||||
Synchronize(@StartScan);
|
||||
|
||||
try
|
||||
if pScanResult.IsImage then
|
||||
pSectorBufferSize := cSectorBufferSize
|
||||
else
|
||||
pSectorBufferSize := cClearBufferSize;
|
||||
|
||||
pClearBufferSize := cClearBufferSize;
|
||||
|
||||
SectorBuffer := GetMemory(pSectorBufferSize);
|
||||
ClearBuffer := GetMemory(pClearBufferSize);
|
||||
|
||||
pSrcFileStream := TFileStream.Create(pScanResult.ScanFile, fmOpenRead or
|
||||
fmShareDenyWrite);
|
||||
|
||||
pSrcFileStream.Position := 0;
|
||||
|
||||
TIM := CreateTIM;
|
||||
|
||||
pStatusText := sStatusBarScanningFile;
|
||||
Synchronize(@SetStatusText);
|
||||
|
||||
pRealBufSize := pSrcFileStream.Read(SectorBuffer^[0], pSectorBufferSize);
|
||||
Inc(pFilePos, pRealBufSize);
|
||||
ClearSectorBuffer(SectorBuffer, ClearBuffer);
|
||||
|
||||
pScanFinished := False;
|
||||
pTIMNumber := 0;
|
||||
|
||||
while (not pStopScan) or (not Terminated) do
|
||||
begin
|
||||
if LoadTimFromBuf(ClearBuffer, TIM, pClearBufferPosition) then
|
||||
begin
|
||||
if pScanResult.IsImage then
|
||||
pTimPosition := pFilePos - pRealBufSize +
|
||||
((pClearBufferPosition - 1) div cSectorDataSize) * cSectorSize +
|
||||
((pClearBufferPosition - 1) mod cSectorDataSize) + cSectorInfoSize
|
||||
else
|
||||
pTimPosition := pFilePos - pRealBufSize + (pClearBufferPosition - 1);
|
||||
|
||||
if pTimPosition >= pFileSize then Break;
|
||||
|
||||
TIM^.dwTimPosition := pTimPosition;
|
||||
Inc(pTIMNumber);
|
||||
TIM^.dwTimNumber := pTIMNumber;
|
||||
AddResult(TIM);
|
||||
end;
|
||||
|
||||
if pClearBufferPosition = (pClearBufferSize div 2) then
|
||||
begin
|
||||
if pScanFinished then Break;
|
||||
|
||||
pScanFinished := (pFilePos = pFileSize);
|
||||
pClearBufferPosition := 0;
|
||||
Move(SectorBuffer^[pSectorBufferSize div 2], SectorBuffer^[0], pSectorBufferSize div 2);
|
||||
|
||||
if pScanFinished then
|
||||
begin
|
||||
if pRealBufSize >= (pSectorBufferSize div 2) then
|
||||
// Need to check file size
|
||||
pRealBufSize := pRealBufSize - (pSectorBufferSize div 2);
|
||||
end
|
||||
else
|
||||
begin
|
||||
pRealBufSize := pSrcFileStream.Read(SectorBuffer^[pSectorBufferSize div 2], pSectorBufferSize div 2);
|
||||
Inc(pFilePos, pRealBufSize);
|
||||
pRealBufSize := pRealBufSize + (pSectorBufferSize div 2);
|
||||
end;
|
||||
|
||||
Synchronize(@UpdateProgressBar);
|
||||
|
||||
ClearSectorBuffer(SectorBuffer, ClearBuffer);
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
FreeTIM(TIM);
|
||||
FreeMemory(SectorBuffer);
|
||||
FreeMemory(ClearBuffer);
|
||||
|
||||
pSrcFileStream.Free;
|
||||
pStopScan := True;
|
||||
pFilePos := 0;
|
||||
pStatusText := '';
|
||||
|
||||
Synchronize(@FinishScan);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TScanThread.FinishScan;
|
||||
begin
|
||||
UpdateProgressBar;
|
||||
SetStatusText;
|
||||
|
||||
if pScanResult.Count = 0 then
|
||||
begin
|
||||
pScanResult.Free;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if not frmMain.CheckForFileOpened(pScanResult.ScanFile) then
|
||||
begin
|
||||
frmMain.ScanResults.Add(pScanResult);
|
||||
frmMain.cbbFiles.Items.Add(pScanResult.ScanFile);
|
||||
end
|
||||
else
|
||||
pScanResult.Free;
|
||||
end;
|
||||
|
||||
procedure TScanThread.SetStatusText;
|
||||
begin
|
||||
frmMain.lblStatus.Caption := pStatusText;
|
||||
end;
|
||||
|
||||
procedure TScanThread.StartScan;
|
||||
begin
|
||||
frmMain.cbbFiles.Enabled := False;
|
||||
frmMain.lvList.Enabled := False;
|
||||
frmMain.actExtractTIMs.Enabled := False;
|
||||
frmMain.actExtractPNGs.Enabled := False;
|
||||
|
||||
frmMain.pbProgress.Max := FileSize(pScanResult.ScanFile);
|
||||
frmMain.pbProgress.Position := 0;
|
||||
end;
|
||||
|
||||
procedure TScanThread.UpdateProgressBar;
|
||||
begin
|
||||
frmMain.pbProgress.Position := pFilePos;
|
||||
frmMain.lvList.Column[0].Caption := Format('# / %d', [pScanResult.Count]);
|
||||
end;
|
||||
|
||||
procedure TScanThread.ClearSectorBuffer(SectorBuffer, ClearBuffer: PBytesArray);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
FillChar(ClearBuffer^[0], pClearBufferSize, 0);
|
||||
if not pScanResult.IsImage then
|
||||
begin
|
||||
Move(SectorBuffer^[0], ClearBuffer^[0], pClearBufferSize);
|
||||
Exit;
|
||||
end;
|
||||
for i := 1 to (pSectorBufferSize div cSectorSize) do
|
||||
begin
|
||||
Move(SectorBuffer^[(i - 1) * cSectorSize + cSectorInfoSize],
|
||||
ClearBuffer^[(i - 1) * cSectorDataSize], cSectorDataSize);
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user