Added x64 version (able to scan big lists of files); Fixed ScanDirectory function (now it properly scans big lists); Fixed StopScan button's behavior (now it able to stop multiple scan threads).

2014-04-10 11:15:02 +00:00
parent c062ecc92b
commit 0cf451dc17
9 changed files with 91 additions and 52 deletions
--- a/tim2view.dpr
+++ b/tim2view.dpr
@@ -14,9 +14,9 @@ uses
  uTIM in 'units\uTIM.pas',
  uDrawTIM in 'units\uDrawTIM.pas',
  uEventWaitThread in 'units\uEventWaitThread.pas',
-  uBrowseForFolder in 'units\uBrowseForFolder.pas',
  uScanResult in 'units\uScanResult.pas',
-  uSettings in 'units\uSettings.pas';
+  uSettings in 'units\uSettings.pas',
+  uBrowseForFolder in 'units\uBrowseForFolder.pas';

 {$R *.res}

--- a/tim2view.dproj
+++ b/tim2view.dproj
@@ -6,8 +6,8 @@
        <MainSource>tim2view.dpr</MainSource>
        <Base>True</Base>
        <Config Condition="'$(Config)'==''">Release</Config>
-        <Platform Condition="'$(Platform)'==''">Win32</Platform>
-        <TargetedPlatforms>1</TargetedPlatforms>
+        <Platform Condition="'$(Platform)'==''">Win64</Platform>
+        <TargetedPlatforms>3</TargetedPlatforms>
        <AppType>Application</AppType>
    </PropertyGroup>
    <PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
@@ -34,6 +34,12 @@
        <Cfg_1>true</Cfg_1>
        <Base>true</Base>
    </PropertyGroup>
+    <PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win64)'!=''">
+        <Cfg_1_Win64>true</Cfg_1_Win64>
+        <CfgParent>Cfg_1</CfgParent>
+        <Cfg_1>true</Cfg_1>
+        <Base>true</Base>
+    </PropertyGroup>
    <PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_2)'!=''">
        <Cfg_2>true</Cfg_2>
        <CfgParent>Base</CfgParent>
@@ -45,6 +51,12 @@
        <Cfg_2>true</Cfg_2>
        <Base>true</Base>
    </PropertyGroup>
+    <PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win64)'!=''">
+        <Cfg_2_Win64>true</Cfg_2_Win64>
+        <CfgParent>Cfg_2</CfgParent>
+        <Cfg_2>true</Cfg_2>
+        <Base>true</Base>
+    </PropertyGroup>
    <PropertyGroup Condition="'$(Base)'!=''">
        <DCC_UsePackage>bindcompfmx;fmx;rtl;dbrtl;DbxClientDriver;IndySystem;bindcomp;inetdb;DataSnapClient;DataSnapServer;DataSnapCommon;DBXInterBaseDriver;DataSnapProviderClient;xmlrtl;DbxCommonDriver;IndyProtocols;dbxcds;DBXMySQLDriver;bindengine;soaprtl;DBXOracleDriver;CustomIPTransport;dsnap;DBXInformixDriver;IndyCore;fmxase;DBXFirebirdDriver;inet;fmxobj;inetdbxpress;DBXSybaseASADriver;fmxdae;IPIndyImpl;dbexpress;DataSnapIndy10ServerTransport;$(DCC_UsePackage)</DCC_UsePackage>
        <DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace)</DCC_Namespace>
@@ -59,7 +71,7 @@
    </PropertyGroup>
    <PropertyGroup Condition="'$(Base_Win32)'!=''">
        <DCC_UnitSearchPath>.\units;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
-        <DCC_UsePackage>vcldbx;TeeDB;inetdbbde;vclib;DBXOdbcDriver;Tee;DBXSybaseASEDriver;ibxpress;svnui;vclimg;fmi;intrawebdb_120_160;vclactnband;vcldb;FMXTee;vcldsnap;bindcompvcl;TeeUI;vclie;DBXDb2Driver;Intraweb_120_160;vcltouch;websnap;vclribbon;VclSmp;vcl;DataSnapConnectors;CloudService;DBXMSSQLDriver;FmxTeeUI;dsnapcon;vclx;webdsnap;svn;bdertl;adortl;$(DCC_UsePackage)</DCC_UsePackage>
+        <DCC_UsePackage>vcldbx;TeeDB;inetdbbde;vclib;DBXOdbcDriver;Tee;DBXSybaseASEDriver;ibxpress;svnui;vclimg;fmi;intrawebdb_120_160;vclactnband;vcldb;FMXTee;vcldsnap;bindcompvcl;TeeUI;vclie;DBXDb2Driver;Intraweb_120_160;vcltouch;websnap;vclribbon;VclSmp;vcl;DataSnapConnectors;CloudService;DBXMSSQLDriver;FmxTeeUI;dsnapcon;vclx;webdsnap;svn;bdertl;adortl;PBFolderDialogPackRun;$(DCC_UsePackage)</DCC_UsePackage>
        <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
        <DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
        <VerInfo_Locale>1033</VerInfo_Locale>
@@ -67,6 +79,11 @@
        <VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
    </PropertyGroup>
    <PropertyGroup Condition="'$(Base_Win64)'!=''">
+        <Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
+        <VerInfo_Locale>1033</VerInfo_Locale>
+        <DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace)</DCC_Namespace>
+        <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
+        <VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
        <DCC_UsePackage>DBXOdbcDriver;DBXSybaseASEDriver;vclimg;vclactnband;vcldb;vcldsnap;bindcompvcl;vclie;DBXDb2Driver;vcltouch;websnap;VclSmp;vcl;DBXMSSQLDriver;dsnapcon;vclx;webdsnap;adortl;$(DCC_UsePackage)</DCC_UsePackage>
    </PropertyGroup>
    <PropertyGroup Condition="'$(Cfg_1)'!=''">
@@ -80,6 +97,7 @@
        <DCC_RemoteDebug>true</DCC_RemoteDebug>
    </PropertyGroup>
    <PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
+        <DCC_IMPLICIT_STRING_CAST>false</DCC_IMPLICIT_STRING_CAST>
        <DCC_SUSPICIOUS_TYPECAST>false</DCC_SUSPICIOUS_TYPECAST>
        <DCC_MapFile>3</DCC_MapFile>
        <DCC_Optimize>true</DCC_Optimize>
@@ -95,6 +113,11 @@
        <VerInfo_Locale>1033</VerInfo_Locale>
        <DCC_RemoteDebug>false</DCC_RemoteDebug>
    </PropertyGroup>
+    <PropertyGroup Condition="'$(Cfg_1_Win64)'!=''">
+        <DCC_MapFile>3</DCC_MapFile>
+        <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
+        <Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
+    </PropertyGroup>
    <PropertyGroup Condition="'$(Cfg_2)'!=''">
        <DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
        <DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
@@ -102,15 +125,24 @@
        <DCC_DebugInformation>0</DCC_DebugInformation>
    </PropertyGroup>
    <PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
+        <DCC_IMPLICIT_STRING_CAST>false</DCC_IMPLICIT_STRING_CAST>
+        <DCC_LocalDebugSymbols>true</DCC_LocalDebugSymbols>
+        <DCC_MapFile>3</DCC_MapFile>
+        <DCC_MaxStackSize>10485760</DCC_MaxStackSize>
        <VerInfo_Keys>CompanyName=Lab 313;FileDescription=The best TIMs tool ever!:);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
        <DCC_DebugInformation>true</DCC_DebugInformation>
-        <DCC_LocalDebugSymbols>true</DCC_LocalDebugSymbols>
-        <DCC_Define>madExcept;LeakChecking;$(DCC_Define)</DCC_Define>
-        <DCC_MapFile>3</DCC_MapFile>
        <VerInfo_Locale>1033</VerInfo_Locale>
        <DCC_IOChecking>false</DCC_IOChecking>
        <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
    </PropertyGroup>
+    <PropertyGroup Condition="'$(Cfg_2_Win64)'!=''">
+        <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
+        <VerInfo_Locale>1033</VerInfo_Locale>
+        <DCC_IMPLICIT_STRING_CAST>false</DCC_IMPLICIT_STRING_CAST>
+        <DCC_MapFile>3</DCC_MapFile>
+        <DCC_DebugInformation>true</DCC_DebugInformation>
+        <DCC_LocalDebugSymbols>true</DCC_LocalDebugSymbols>
+    </PropertyGroup>
    <ItemGroup>
        <DelphiCompile Include="$(MainSource)">
            <MainSource>MainSource</MainSource>
@@ -126,9 +158,9 @@
        <DCCReference Include="units\uTIM.pas"/>
        <DCCReference Include="units\uDrawTIM.pas"/>
        <DCCReference Include="units\uEventWaitThread.pas"/>
-        <DCCReference Include="units\uBrowseForFolder.pas"/>
        <DCCReference Include="units\uScanResult.pas"/>
        <DCCReference Include="units\uSettings.pas"/>
+        <DCCReference Include="units\uBrowseForFolder.pas"/>
        <BuildConfiguration Include="Release">
            <Key>Cfg_2</Key>
            <CfgParent>Base</CfgParent>
@@ -184,7 +216,7 @@
            <Deployment/>
            <Platforms>
                <Platform value="Win32">True</Platform>
-                <Platform value="Win64">False</Platform>
+                <Platform value="Win64">True</Platform>
            </Platforms>
        </BorlandProject>
        <ProjectFileVersion>12</ProjectFileVersion>
--- a/tim2view.res
+++ b/tim2view.res
--- a/units/uBrowseForFolder.pas
+++ b/units/uBrowseForFolder.pas
@@ -21,6 +21,7 @@ function BrowseForFolderCallBack(Wnd: HWND; uMsg: UINT; lParam, lpData: lParam)
 begin
  if uMsg = BFFM_INITIALIZED then
    SendMessage(Wnd, BFFM_SETSELECTION, 1, Integer(@lg_StartFolder[1]));
+
  result := 0;
 end;

@@ -52,7 +53,7 @@ begin
  browse_info.pszDisplayName := @folder[0];
  browse_info.lpszTitle := PChar(browseTitle);
  browse_info.ulFlags := BIF_DONTGOBELOWDOMAIN or BIF_RETURNONLYFSDIRS or
-    BIF_STATUSTEXT or BIF_VALIDATE or BIF_USENEWUI or BIF_NONEWFOLDERBUTTON;
+    BIF_STATUSTEXT or BIF_VALIDATE {or BIF_USENEWUI} or BIF_NONEWFOLDERBUTTON;

  browse_info.hwndOwner := appHWND;
  if initialFolder <> '' then
--- a/units/uCommon.pas
+++ b/units/uCommon.pas
@@ -26,7 +26,6 @@ type
  TBytesArray = array [0 .. cMaxFileSize - 1] of byte;
  PBytesArray = ^TBytesArray;

-function GetStartDir: string;
 function GetFileSizeAPI(const FileName: string): Int64;
 function CheckFileExists(const FileName: string): boolean;
 // function cHex2Int( const Value : string) : Integer;
@@ -124,7 +123,7 @@ var
  FindData: TWin32FindData;
  hFind: THandle;
 begin
-  Result := -1;
+  Result := 0;
  hFind := FindFirstFile(PChar(FileName), FindData);

  if hFind <> INVALID_HANDLE_VALUE then
@@ -137,21 +136,4 @@ begin

 end;

-function GetStartDir: string;
-const
-  MAX_PATH = 260;
-var
-  Buffer: array [0 .. MAX_PATH] of Char;
-  I: Integer;
-begin
-  I := GetModuleFileName(0, Buffer, MAX_PATH);
-  for I := I downto 0 do
-    if Buffer[I] = '\' then
-    begin
-      Buffer[I + 1] := #0;
-      break;
-    end;
-  Result := Buffer;
-end;
-
 end.
--- a/units/uDrawTIM.pas
+++ b/units/uDrawTIM.pas
@@ -119,14 +119,14 @@ begin

  IMAGE_DATA_POS := 0;

+  Transparent := TranspMode in [0, 1];
+  SemiTransparent := TranspMode in [0, 2];
+
  R := 0;
  G := 0;
  B := 0;
  STP := 0;

-  Transparent := TranspMode in [0, 1];
-  SemiTransparent := TranspMode in [0, 2];
-
  for Y := 1 to RH do
    for X := 1 to RW do
    begin
--- a/units/uMain.pas
+++ b/units/uMain.pas
@@ -342,7 +342,7 @@ begin

    TIM_NAME := Format(cAutoExtractionTimFormat, [ExtractJustName(FName), I, BIT_MODE]);

-    Path := IncludeTrailingPathDelimiter(GetStartDir + cExtractedTimsDir);
+    Path := IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0)) + cExtractedTimsDir);
    CreateDir(Path);
    Path := IncludeTrailingPathDelimiter(Path + ExtractFileName(FName));
    CreateDir(Path);
@@ -403,6 +403,7 @@ begin
  begin
    ScanPath(SelectedDir);
    LastDir := SelectedDir;
+    Settings.LastDir := LastDir;
  end;
 end;

@@ -500,10 +501,20 @@ begin
 end;

 procedure TfrmMain.btnStopScanClick(Sender: TObject);
+var
+  I: Integer;
 begin
  if ScanThreads.Count = 0 then Exit;

-  ScanThreads.First.StopScan := True;
+  for I := 1 to ScanThreads.Count do
+    ScanThreads[I - 1].StopScan := True;
+
+  ScanThreads.Clear;
+  StartedScans := 0;
+  btnStopScan.Tag := NativeInt(True);
+
+  ScanFinished(nil);
+
  actReturnFocusExecute(Self);
 end;

@@ -676,6 +687,7 @@ begin

  actStretch.Checked := Settings.StretchMode;
  cbbTranspMode.ItemIndex := Settings.TranspMode;
+  LastDir := Settings.LastDir;

  hGridRect.Top := -1;
  hGridRect.Left := -1;
@@ -690,7 +702,7 @@ begin
  StartedScans := 0;
  New(PNG);
  PNG^ := nil;
-  LastDir := GetStartDir;
+
  SetCLUTListToNoCLUT;
  Caption := Format('%s v%s', [cProgramName, cProgramVersion]);
  DragAcceptFiles(Handle, True);
@@ -792,14 +804,15 @@ var
  Dir: string;
 begin
  Dir := IncludeTrailingPathDelimiter(Directory);
-  isFound := FindFirst(Dir + '*.*', faAnyFile, sRec) = 0;
+  isFound := FindFirst(Dir + '*', faAnyFile, sRec) = 0;
  while isFound do
  begin
    if (sRec.Name <> '.') and (sRec.Name <> '..') then
    begin
      if (sRec.Attr and faDirectory) = faDirectory then
-        ScanDirectory(Dir + sRec.Name);
-      ScanPath(Dir + sRec.Name);
+        ScanDirectory(Dir + sRec.Name)
+      else
+        ScanFile(Dir + sRec.Name);
    end;
    Application.ProcessMessages;
    isFound := FindNext(sRec) = 0;
@@ -867,10 +880,13 @@ begin
  begin
    cbbFiles.ItemIndex := cbbFiles.Items.IndexOf(FileName);
    btnStopScan.Enabled := False;
+    btnStopScan.Tag := NativeInt(True);
    CheckButtonsAndMainMenu;
    Exit;
  end;

+  if not Boolean(btnStopScan.Tag) then
+  begin
    ScanThreads.Add(TScanThread.Create(FileName, GetImageScan(FileName)));
    ScanThreads.Last.FreeOnTerminate := True;
    ScanThreads.Last.Priority := tpNormal;
@@ -882,6 +898,7 @@ begin
      Inc(StartedScans);
    end;
  end;
+end;

 procedure TfrmMain.ScanFinished(Sender: TObject);
 var
@@ -893,7 +910,7 @@ begin
  if ScanThreads.Count <> 0 then
  begin
    for I := 1 to ScanThreads.Count do
-      if ScanThreads[I - 1].Suspended then
+      if ScanThreads[I - 1].Suspended and (not ScanThreads[I - 1].StopScan) then
      begin
        ScanThreads[I - 1].Start;
        Inc(StartedScans);
@@ -913,12 +930,16 @@ begin
  end;

  btnStopScan.Enabled := False;
+  btnStopScan.Tag := NativeInt(True);
 end;

 procedure TfrmMain.ScanPath(const Path: string);
 begin
  if Path = '' then Exit;

+  btnStopScan.Enabled := True;
+  btnStopScan.Tag := NativeInt(False);
+
  if CheckFileExists(Path) then
    ScanFile(Path)
  else
--- a/units/uScanThread.pas
+++ b/units/uScanThread.pas
@@ -29,7 +29,7 @@ type
  public
    constructor Create(const FileToScan: string; ImageScan: boolean);
    //property Started: boolean read pStarted write pStarted;
-    property StopScan: boolean write pStopScan;
+    property StopScan: boolean read pStopScan write pStopScan;
  end;

 implementation
@@ -115,7 +115,8 @@ begin
  pScanFinished := False;
  pTIMNumber := 0;

-  repeat
+  while not pStopScan do
+  begin
    if LoadTimFromBuf(ClearBuffer, TIM, pClearBufferPosition) then
    begin
      if pScanResult.IsImage then
@@ -158,12 +159,13 @@ begin

      ClearSectorBuffer(SectorBuffer, ClearBuffer);
    end;
-  until pStopScan;
+  end;
  FreeTIM(TIM);
  FreeMemory(SectorBuffer);
  FreeMemory(ClearBuffer);

  pSrcFileStream.Free;
+  pStopScan := True;
  pFilePos := 0;
  pStatusText := '';

@@ -197,7 +199,6 @@ end;

 procedure TScanThread.StartScan;
 begin
-  frmMain.btnStopScan.Enabled := True;
  frmMain.cbbFiles.Enabled := False;
  frmMain.lvList.Enabled := False;
  frmMain.actExtractList.Enabled := False;
--- a/units/uSettings.pas
+++ b/units/uSettings.pas
@@ -19,11 +19,13 @@ unit uSettings;
   private
     FTranspMode: Integer;
     FStretchMode: Boolean;
+     FLastDir: string;
   public
     constructor Create;
   published
     property TranspMode: Integer read FTranspMode write FTranspMode;
     property StretchMode: Boolean read FStretchMode write FStretchMode;
+     property LastDir: string read FLastDir write FLastDir;
   end;

 var