From 8f034ebc019b1c9f6133814c439cf38f91f2bb13 Mon Sep 17 00:00:00 2001 From: Tomas Bzatek Date: Sun, 13 Dec 2009 22:02:51 +0100 Subject: Set corresponding label and progress bar visibility in progress dialog --- UCoreWorkers.pas | 1551 +++++++++++++++++++++++++++--------------------------- 1 file changed, 766 insertions(+), 785 deletions(-) (limited to 'UCoreWorkers.pas') diff --git a/UCoreWorkers.pas b/UCoreWorkers.pas index 757afca..a2a4f6a 100644 --- a/UCoreWorkers.pas +++ b/UCoreWorkers.pas @@ -22,6 +22,9 @@ interface uses glib2, gtk2, SyncObjs, Classes, GTKForms, GTKView, ULibc, UEngines, UCoreUtils, UVFSCore, uVFSprototypes, UCore; +type TWorkerThreadJobType = (WORKER_JOB_DUMMY, WORKER_JOB_DELETE, WORKER_JOB_COPY, WORKER_JOB_MOVE, WORKER_JOB_MERGE, WORKER_JOB_SPLIT, + WORKER_JOB_CHMOD, WORKER_JOB_CHOWN); + type TVFSCallbackThread = class(TThread) private FThreadID: __pthread_t; @@ -70,10 +73,19 @@ type TVFSCallbackThread = class(TThread) TWorkerThread = class(TVFSCallbackThread) private GUIMutex: TCriticalSection; + procedure DeleteFilesWorker; + procedure CopyFilesWorker; + procedure MergeFilesWorker; + procedure SplitFilesWorker; + procedure ChmodFilesWorker; + procedure ChownFilesWorker; + procedure DummyThreadWorker; protected procedure Execute; override; procedure CommitGUIUpdate; public + JobType: TWorkerThreadJobType; + // Data to update FProgress1Pos, FProgress2Pos, FProgress1Max, FProgress2Max: Int64; FProgress1Text, FProgress2Text, FLabel1Text, FLabel2Text: string; @@ -115,7 +127,6 @@ type TVFSCallbackThread = class(TThread) ParamCardinal1, ParamCardinal2: Cardinal; ParamFloat1, ParamFloat2: Extended; ParamDataItem1: PDataItem; - WorkerProcedure: procedure(SenderThread: TWorkerThread); SelectedItem: PDataItem; ExtractFromVFSMode, ExtractFromVFSAll: boolean; ErrorHappened: boolean; @@ -172,15 +183,6 @@ type TVFSCallbackThread = class(TThread) end; -// Thread aware functions (also half-thread-safe) without any piece of GTK code -procedure DeleteFilesWorker(SenderThread: TWorkerThread); -procedure CopyFilesWorker(SenderThread: TWorkerThread); -procedure MergeFilesWorker(SenderThread: TWorkerThread); -procedure SplitFilesWorker(SenderThread: TWorkerThread); -procedure ChmodFilesWorker(SenderThread: TWorkerThread); -procedure ChownFilesWorker(SenderThread: TWorkerThread); -procedure DummyThreadWorker(SenderThread: TWorkerThread); - // Worker threads utilities // These should be called from main thread procedure ProcessThreadEvents(SenderThread: TVFSCallbackThread); @@ -193,6 +195,7 @@ uses SysUtils, DateUtils, StrUtils, UConfig, UDirDelete, UOverwrite, ULocale, crc; + (********************************************************************************************************************************) constructor TVFSCallbackThread.Create(CreateSuspended: boolean); begin @@ -372,8 +375,16 @@ procedure TWorkerThread.Execute; begin PrepareExecute; try - if Assigned(WorkerProcedure) then - WorkerProcedure(Self); + case JobType of + WORKER_JOB_DUMMY: DummyThreadWorker; + WORKER_JOB_DELETE: DeleteFilesWorker; + WORKER_JOB_COPY, + WORKER_JOB_MOVE: CopyFilesWorker; + WORKER_JOB_MERGE: MergeFilesWorker; + WORKER_JOB_SPLIT: SplitFilesWorker; + WORKER_JOB_CHMOD: ChmodFilesWorker; + WORKER_JOB_CHOWN: ChownFilesWorker; + end; finally Finished := True; end; @@ -388,7 +399,6 @@ begin Engine := nil; DataList := nil; ParamPointer1 := nil; - WorkerProcedure := nil; SelectedItem := nil; FShowCancelMessage := False; FDialogShowDirDelete := False; @@ -403,6 +413,7 @@ begin ParamBool4 := False; ParamBool5 := False; FGUIChanged := False; + JobType := WORKER_JOB_DUMMY; end; destructor TWorkerThread.Destroy; @@ -568,10 +579,17 @@ begin if SenderThread is TWorkerThread then begin AFProgress := TFProgress.Create(SenderThread.DialogsParentWindow); ParentDialogForm := AFProgress; - // * TODO - AFProgress.Label1.Caption := LANGCopySC; - // * TODO - AFProgress.SetNumBars(True); + case (SenderThread as TWorkerThread).JobType of + WORKER_JOB_DUMMY: AFProgress.Label1.Caption := ''; + WORKER_JOB_DELETE: AFProgress.Label1.Caption := LANGDelete; + WORKER_JOB_COPY: AFProgress.Label1.Caption := LANGCopySC; + WORKER_JOB_MOVE: AFProgress.Label1.Caption := LANGMoveRenameSC; + WORKER_JOB_MERGE: AFProgress.Label1.Caption := LANGMergeSC; + WORKER_JOB_SPLIT: AFProgress.Label1.Caption := LANGSplitSC; + WORKER_JOB_CHMOD: AFProgress.Label1.Caption := LANGChmodProgress; + WORKER_JOB_CHOWN: AFProgress.Label1.Caption := LANGChownProgress; + end; + AFProgress.SetNumBars((SenderThread as TWorkerThread).JobType in [WORKER_JOB_COPY, WORKER_JOB_MOVE, WORKER_JOB_MERGE]); AFProgress.ProgressBar.Fraction := 0; AFProgress.ProgressBar2.Fraction := 0; AFProgress.ShowModal; @@ -757,7 +775,7 @@ end; (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) -procedure DeleteFilesWorker(SenderThread: TWorkerThread); +procedure TWorkerThread.DeleteFilesWorker; var SkipAll: boolean; // Return False to break the operation @@ -770,12 +788,12 @@ var SkipAll: boolean; Error := nil; // DebugMsg(['Debug: IsDir: ', AFileRec^.IsDir, ', Stage1: ', AFileRec^.Stage1, ', IsLnk: ', AFileRec^.IsLnk, '; Result = ', AFileRec^.IsDir and AFileRec^.Stage1 and (not AFileRec^.IsLnk)]); if AFileRec^.DataItem^.IsDir and AFileRec^.Stage1 and (not AFileRec^.DataItem^.IsLnk) then Exit; - Res := SenderThread.Engine.Remove(String(AFileRec^.DataItem^.FName), @Error); + Res := Engine.Remove(String(AFileRec^.DataItem^.FName), @Error); // DebugMsg(['Result : ', Res]); if not Res then if SkipAll then Result := True else begin - Response := SenderThread.ShowDirDeleteDialog(1, LANGTheFileDirectory, String(AFileRec^.DataItem^.FDisplayName), + Response := ShowDirDeleteDialog(1, LANGTheFileDirectory, String(AFileRec^.DataItem^.FDisplayName), Format(LANGCouldNotBeDeletedS, [Error^.message])); case Response of 1 : Result := True; @@ -800,63 +818,61 @@ var i: longint; begin SkipAll := False; AList := TList.Create; - with SenderThread do begin - CurrPath := IncludeTrailingPathDelimiter(Engine.Path); - PrepareJobFilesFromPanel(AList, False); - // * TODO: catch the error - if not Engine.ChangeDir(CurrPath, nil) then - DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour might occur.']); - libc_chdir('/'); - - SetProgress1Params(AList.Count); - CommitGUIUpdate; - DeleteAll := False; - SkipToNext := False; - - DebugWriteListSL(AList); - - if AList.Count = 1 then Fr := 1 else Fr := 100 / (AList.Count - 1); - if AList.Count > 0 then - for i := 0 to AList.Count - 1 do begin - if FCancelled then begin - FCancelMessage := LANGUserCancelled; - FShowCancelMessage := True; - Break; - end; - if SkipToNext and (PDataItemSL(AList[i])^.Level > 1) then Continue; - if SkipToNext and (PDataItemSL(AList[i])^.Level = 1) and (not PDataItemSL(AList[i])^.Stage1) then begin - SkipToNext := False; - Continue; - end; - // Check for non-empty directory - if (not DeleteAll) and (PDataItemSL(AList[i])^.Level = 1) and PDataItemSL(AList[i])^.Stage1 and PDataItemSL(AList[i])^.DataItem^.IsDir and - (not PDataItemSL(AList[i])^.DataItem^.IsLnk) and (i < AList.Count - 2) and (PDataItemSL(AList[i + 1])^.Level = 2) then - begin - Response := ShowDirDeleteDialog(4, Format(LANGTheDirectorySIsNotEmpty, [string(PDataItemSL(AList[i])^.DataItem^.FDisplayName)]), - LANGDoYouWantToDeleteItWithAllItsFilesAndSubdirectories); - case Response of - 1 : ; // Do nothing in this case - I will not bother with changing the structure; it works :-) - 2 : DeleteAll := True; - 3 : SkipToNext := True; - else Break; - end; + CurrPath := IncludeTrailingPathDelimiter(Engine.Path); + PrepareJobFilesFromPanel(AList, False); + // * TODO: catch the error + if not Engine.ChangeDir(CurrPath, nil) then + DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour might occur.']); + libc_chdir('/'); + + SetProgress1Params(AList.Count); + CommitGUIUpdate; + DeleteAll := False; + SkipToNext := False; + + DebugWriteListSL(AList); + + if AList.Count = 1 then Fr := 1 else Fr := 100 / (AList.Count - 1); + if AList.Count > 0 then + for i := 0 to AList.Count - 1 do begin + if FCancelled then begin + FCancelMessage := LANGUserCancelled; + FShowCancelMessage := True; + Break; + end; + if SkipToNext and (PDataItemSL(AList[i])^.Level > 1) then Continue; + if SkipToNext and (PDataItemSL(AList[i])^.Level = 1) and (not PDataItemSL(AList[i])^.Stage1) then begin + SkipToNext := False; + Continue; + end; + // Check for non-empty directory + if (not DeleteAll) and (PDataItemSL(AList[i])^.Level = 1) and PDataItemSL(AList[i])^.Stage1 and PDataItemSL(AList[i])^.DataItem^.IsDir and + (not PDataItemSL(AList[i])^.DataItem^.IsLnk) and (i < AList.Count - 2) and (PDataItemSL(AList[i + 1])^.Level = 2) then + begin + Response := ShowDirDeleteDialog(4, Format(LANGTheDirectorySIsNotEmpty, [string(PDataItemSL(AList[i])^.DataItem^.FDisplayName)]), + LANGDoYouWantToDeleteItWithAllItsFilesAndSubdirectories); + case Response of + 1 : ; // Do nothing in this case - I will not bother with changing the structure; it works :-) + 2 : DeleteAll := True; + 3 : SkipToNext := True; + else Break; end; - // Process delete - if not HandleDelete(AList[i]) then Break; - UpdateProgress1(i, Format('%d%%', [Round(Fr * i)])); - UpdateCaption1(PDataItemSL(AList[i])^.DataItem^.FDisplayName); - CommitGUIUpdate; end; + // Process delete + if not HandleDelete(AList[i]) then Break; + UpdateProgress1(i, Format('%d%%', [Round(Fr * i)])); + UpdateCaption1(PDataItemSL(AList[i])^.DataItem^.FDisplayName); + CommitGUIUpdate; + end; - // Free the objects - if AList.Count > 0 then - for i := AList.Count - 1 downto 0 do FreeDataItem(PDataItemSL(AList[i])); - AList.Clear; - AList.Free; - // * TODO: catch the error - if not Engine.ChangeDir(CurrPath, nil) then - DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour might occur.']); - end; + // Free the objects + if AList.Count > 0 then + for i := AList.Count - 1 downto 0 do FreeDataItem(PDataItemSL(AList[i])); + AList.Clear; + AList.Free; + // * TODO: catch the error + if not Engine.ChangeDir(CurrPath, nil) then + DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour might occur.']); end; @@ -929,7 +945,7 @@ end; end; -procedure CopyFilesWorker(SenderThread: TWorkerThread); +procedure TWorkerThread.CopyFilesWorker; // ParamFloat1 = Fr - internal // ParamFloat2 = Fr2 - internal // ParamInt64 = SizeDone - internal @@ -956,69 +972,67 @@ var DefResponse: integer; // Global variables for this function Error: PGError; begin DebugMsg(['ManualCopyFile: ', SourceFile, ' ---> ', DestFile]); - with SenderThread do begin - Result := False; - Error := nil; - fsrc := SrcEngine.OpenFile(SourceFile, omRead, @Error); - if fsrc = nil then begin - // * TODO: set real error, also free it - CopyFilesWorker_ErrorFunc(SenderThread, 2, 1 { Error }, SourceFile); // Cannot open source file - Exit; - end; - if Append then fdst := DestEngine.OpenFile(DestFile, omAppend, @Error) - else fdst := DestEngine.OpenFile(DestFile, omWrite, @Error); - if fdst = nil then begin - // * TODO: set real error, also free it - SrcEngine.CloseFile(fsrc, nil); - CopyFilesWorker_ErrorFunc(SenderThread, 3, 1 { Error }, SourceFile); // Cannot open target file - Exit; - end; - - BytesDone := 0; - Res := True; + Result := False; + Error := nil; + fsrc := SrcEngine.OpenFile(SourceFile, omRead, @Error); + if fsrc = nil then begin + // * TODO: set real error, also free it + CopyFilesWorker_ErrorFunc(Self, 2, 1 { Error }, SourceFile); // Cannot open source file + Exit; + end; + if Append then fdst := DestEngine.OpenFile(DestFile, omAppend, @Error) + else fdst := DestEngine.OpenFile(DestFile, omWrite, @Error); + if fdst = nil then begin + // * TODO: set real error, also free it + SrcEngine.CloseFile(fsrc, nil); + CopyFilesWorker_ErrorFunc(Self, 3, 1 { Error }, SourceFile); // Cannot open target file + Exit; + end; - BSize := DestEngine.GetBlockSize; - Buffer := malloc(BSize); - if Buffer = nil then begin - CopyFilesWorker_ErrorFunc(SenderThread, 1, errno, SourceFile); // Memory allocation failed - libc_free(Buffer); - Exit; - end; - memset(Buffer, 0, BSize); + BytesDone := 0; + Res := True; - BytesWritten := 0; - repeat - BytesRead := SrcEngine.ReadFile(fsrc, Buffer, BSize, @Error); - if (BytesRead = 0) and (Error <> nil) then - // * TODO: set real error, also free it - Res := CopyFilesWorker_ErrorFunc(SenderThread, 6, 1 { Error }, SourceFile); // Cannot read from source file - if BytesRead > 0 then begin - Error := nil; - BytesWritten := DestEngine.WriteFile(fdst, Buffer, BytesRead, @Error); - if (BytesWritten < BytesRead) then - // * TODO: set real error, also free it - Res := CopyFilesWorker_ErrorFunc(SenderThread, 7, 1 { Error }, DestFile); // Cannot write to source file - end; - Inc(BytesDone, BytesRead); - if not CopyFilesWorker_ProgressFunc(SenderThread, BytesDone, nil) then begin - Res := False; - Break; - end; - until (BytesRead = 0) or (BytesWritten < BytesRead); + BSize := DestEngine.GetBlockSize; + Buffer := malloc(BSize); + if Buffer = nil then begin + CopyFilesWorker_ErrorFunc(Self, 1, errno, SourceFile); // Memory allocation failed libc_free(Buffer); + Exit; + end; + memset(Buffer, 0, BSize); - // * TODO: set real error, also free it - if not DestEngine.CloseFile(fdst, nil) then begin - CopyFilesWorker_ErrorFunc(SenderThread, 4, errno, DestFile); // Cannot close target file - Exit; + BytesWritten := 0; + repeat + BytesRead := SrcEngine.ReadFile(fsrc, Buffer, BSize, @Error); + if (BytesRead = 0) and (Error <> nil) then + // * TODO: set real error, also free it + Res := CopyFilesWorker_ErrorFunc(Self, 6, 1 { Error }, SourceFile); // Cannot read from source file + if BytesRead > 0 then begin + Error := nil; + BytesWritten := DestEngine.WriteFile(fdst, Buffer, BytesRead, @Error); + if (BytesWritten < BytesRead) then + // * TODO: set real error, also free it + Res := CopyFilesWorker_ErrorFunc(Self, 7, 1 { Error }, DestFile); // Cannot write to source file end; - // * TODO: set real error, also free it - if not SrcEngine.CloseFile(fsrc, nil) then begin - CopyFilesWorker_ErrorFunc(SenderThread, 5, errno, SourceFile); // Cannot close source file - Exit; + Inc(BytesDone, BytesRead); + if not CopyFilesWorker_ProgressFunc(Self, BytesDone, nil) then begin + Res := False; + Break; end; - Result := Res; + until (BytesRead = 0) or (BytesWritten < BytesRead); + libc_free(Buffer); + + // * TODO: set real error, also free it + if not DestEngine.CloseFile(fdst, nil) then begin + CopyFilesWorker_ErrorFunc(Self, 4, errno, DestFile); // Cannot close target file + Exit; + end; + // * TODO: set real error, also free it + if not SrcEngine.CloseFile(fsrc, nil) then begin + CopyFilesWorker_ErrorFunc(Self, 5, errno, SourceFile); // Cannot close source file + Exit; end; + Result := Res; end; // Returns True if the file was successfully copied and will be deleted on move @@ -1027,50 +1041,48 @@ var DefResponse: integer; // Global variables for this function begin Result := False; try - with SenderThread do begin - AEngine := nil; - FCopyProgressFunc := CopyFilesWorker_ProgressFunc; - - // local -> local - if (SrcEngine is TLocalTreeEngine) and (DestEngine is TLocalTreeEngine) - then Result := DestEngine.CopyFileIn(SourceFile, DestFile, Append, @CopyFilesWorker_ProgressFunc, SenderThread) - else - - // from local engine to VFS engine - if (SrcEngine is TLocalTreeEngine) and (DestEngine is TVFSEngine) then - begin - AEngine := DestEngine; - Result := (DestEngine as TVFSEngine).CopyFileInEx(SourceFile, DestFile, Append); - end else - - // from VFS engine to local (most common use) - if (SrcEngine is TVFSEngine) and (DestEngine is TLocalTreeEngine) then - begin - AEngine := SrcEngine; - Result := (SrcEngine as TVFSEngine).CopyFileOutEx(SourceFile, DestFile, Append); - end + AEngine := nil; + FCopyProgressFunc := CopyFilesWorker_ProgressFunc; + + // local -> local + if (SrcEngine is TLocalTreeEngine) and (DestEngine is TLocalTreeEngine) + then Result := DestEngine.CopyFileIn(SourceFile, DestFile, Append, @CopyFilesWorker_ProgressFunc, Self) + else + + // from local engine to VFS engine + if (SrcEngine is TLocalTreeEngine) and (DestEngine is TVFSEngine) then + begin + AEngine := DestEngine; + Result := (DestEngine as TVFSEngine).CopyFileInEx(SourceFile, DestFile, Append); + end else - // VFS to VFS (not supported yet) - else - begin - AEngine := SrcEngine; - Result := ManualCopyFile(SourceFile, DestFile, Append); - end; - AEngine := nil; + // from VFS engine to local (most common use) + if (SrcEngine is TVFSEngine) and (DestEngine is TLocalTreeEngine) then + begin + AEngine := SrcEngine; + Result := (SrcEngine as TVFSEngine).CopyFileOutEx(SourceFile, DestFile, Append); + end + + // VFS to VFS (not supported yet) + else + begin + AEngine := SrcEngine; + Result := ManualCopyFile(SourceFile, DestFile, Append); + end; + AEngine := nil; - // Copy OK? (check size, otherwise delete target file) - if (not Append) and (not Result) then begin - // * TODO: check error - DataSrc := SrcEngine.GetFileInfo(SourceFile, False, True, nil); - if DataSrc = nil then Exit; + // Copy OK? (check size, otherwise delete target file) + if (not Append) and (not Result) then begin + // * TODO: check error + DataSrc := SrcEngine.GetFileInfo(SourceFile, False, True, nil); + if DataSrc = nil then Exit; + // * TODO: check error + DataDest := DestEngine.GetFileInfo(DestFile, False, True, nil); + if (DataDest <> nil) and (DataSrc^.Size <> DataDest^.Size) then // * TODO: check error - DataDest := DestEngine.GetFileInfo(DestFile, False, True, nil); - if (DataDest <> nil) and (DataSrc^.Size <> DataDest^.Size) then - // * TODO: check error - DestEngine.Remove(DestFile, nil); - FreeDataItem(DataSrc); - FreeDataItem(DataDest); - end; + DestEngine.Remove(DestFile, nil); + FreeDataItem(DataSrc); + FreeDataItem(DataDest); end; except on E: Exception do DebugMsg(['*** Exception raised in LocalCopyFile(SourceFile=', SourceFile, ', DestFile=', DestFile, ', Append=', Append, '): (', E.ClassName, '): ', E.Message]); @@ -1079,33 +1091,29 @@ var DefResponse: integer; // Global variables for this function function IsOnSameFS(SrcPath, DestPath: string): boolean; begin - with SenderThread do begin - if (SrcEngine.ClassName <> DestEngine.ClassName) then Result := False else - if (SrcEngine is TVFSEngine) and (DestEngine is TVFSEngine) and - (SrcEngine as TVFSEngine).ArchiveMode and (DestEngine as TVFSEngine).ArchiveMode and - ((SrcEngine as TVFSEngine).ArchivePath <> '') and - ((SrcEngine as TVFSEngine).ArchivePath = (DestEngine as TVFSEngine).ArchivePath) - then Result := True else - Result := DestEngine.IsOnSameFS(SrcPath, DestPath, False); - end; + if (SrcEngine.ClassName <> DestEngine.ClassName) then Result := False else + if (SrcEngine is TVFSEngine) and (DestEngine is TVFSEngine) and + (SrcEngine as TVFSEngine).ArchiveMode and (DestEngine as TVFSEngine).ArchiveMode and + ((SrcEngine as TVFSEngine).ArchivePath <> '') and + ((SrcEngine as TVFSEngine).ArchivePath = (DestEngine as TVFSEngine).ArchivePath) + then Result := True else + Result := DestEngine.IsOnSameFS(SrcPath, DestPath, False); end; function TwoSameFiles(Path1, Path2: string; TestCaseInsensitiveFS: boolean): boolean; begin - with SenderThread do begin - if (SrcEngine.ClassName <> DestEngine.ClassName) then Result := False else - if (SrcEngine is TVFSEngine) and (DestEngine is TVFSEngine) and - ((SrcEngine as TVFSEngine).ArchiveMode <> (DestEngine as TVFSEngine).ArchiveMode) - then Result := False else - if (SrcEngine is TVFSEngine) and (DestEngine is TVFSEngine) and - (SrcEngine as TVFSEngine).ArchiveMode and (DestEngine as TVFSEngine).ArchiveMode and - ((SrcEngine as TVFSEngine).ArchivePath <> '') and - ((SrcEngine as TVFSEngine).ArchivePath <> (DestEngine as TVFSEngine).ArchivePath) - then Result := False else - if WideCompareStr(Path1, Path2) = 0 then Result := True else - // * FIXME: causes stat errors, no need to check every file. - Result := TestCaseInsensitiveFS and DestEngine.TwoSameFiles(Path1, Path2, False); - end; + if (SrcEngine.ClassName <> DestEngine.ClassName) then Result := False else + if (SrcEngine is TVFSEngine) and (DestEngine is TVFSEngine) and + ((SrcEngine as TVFSEngine).ArchiveMode <> (DestEngine as TVFSEngine).ArchiveMode) + then Result := False else + if (SrcEngine is TVFSEngine) and (DestEngine is TVFSEngine) and + (SrcEngine as TVFSEngine).ArchiveMode and (DestEngine as TVFSEngine).ArchiveMode and + ((SrcEngine as TVFSEngine).ArchivePath <> '') and + ((SrcEngine as TVFSEngine).ArchivePath <> (DestEngine as TVFSEngine).ArchivePath) + then Result := False else + if WideCompareStr(Path1, Path2) = 0 then Result := True else + // * FIXME: causes stat errors, no need to check every file. + Result := TestCaseInsensitiveFS and DestEngine.TwoSameFiles(Path1, Path2, False); end; function DoOperation(AFileRec: PDataItemSL; const Dst: string; var ErrorKind: integer; const Append: boolean): integer; @@ -1113,7 +1121,6 @@ var DefResponse: integer; // Global variables for this function ErrorKind := 0; Result := 0; try - with SenderThread do with AFileRec^ do begin if DataItem^.IsLnk then begin // Explicit copy the file @@ -1178,7 +1185,6 @@ var DefResponse: integer; // Global variables for this function begin Result := True; try - with SenderThread do begin // Second stage - change permissions if (not AFileRec^.Stage1) and (ParamBool3 or ((not ParamBool3) and (not AFileRec^.ForceMove))) then @@ -1220,7 +1226,7 @@ var DefResponse: integer; // Global variables for this function DestEngine.MakeDir(ExtractFileDir(NewFilePath), nil); SetProgress1Params(AFileRec^.DataItem^.Size + Ord(AFileRec^.DataItem^.Size = 0)); if AFileRec^.DataItem^.Size <= 1 then ParamFloat2 := 1 else ParamFloat2 := 100 / (AFileRec^.DataItem^.Size - 1); - CopyFilesWorker_ProgressFunc(SenderThread, 0, nil); + CopyFilesWorker_ProgressFunc(Self, 0, nil); Res := 0; if DestEngine.FileExists(NewFilePath, False) and (not (not ParamBool3 and (not TwoSameFiles(NewFilePath, AFileRec^.DataItem^.FName, False)) and TwoSameFiles(NewFilePath, AFileRec^.DataItem^.FName, True))) @@ -1330,7 +1336,6 @@ var DefResponse: integer; // Global variables for this function 0, 124, 255 : Result := False; // Cancel end; end; - end; // DebugMsg(['(II) CopyFilesWorker.HandleCopy: finished']); except on E: Exception do DebugMsg(['*** Exception raised in HandleCopy(AFileRec=', QWord(AFileRec), ', NewFilePath=', NewFilePath, '): (', E.ClassName, '): ', E.Message]); @@ -1347,38 +1352,36 @@ var DefResponse: integer; // Global variables for this function InputFiles: TStringList; begin InputFiles := TStringList.Create; - with SenderThread do begin - if not Ren then begin - InputFiles.Add(FullPath); - end else begin - s := ProcessPattern(DestEngine, ParamString1, CurrPath, ParamFileName, ParamDir); - CaseInsensitiveRename := (WideCompareStr(ParamString1, ParamFileName) <> 0) and (WideCompareText(ParamString1, ParamFileName) = 0) and - ParamDir and DestEngine.TwoSameFiles(IncludeTrailingPathDelimiter(CurrPath) + ParamString1, IncludeTrailingPathDelimiter(CurrPath) + ParamFileName, False); -// DebugMsg(['HandleProcessPattern: s = ', s]); - b := False; - if ParamDir then begin - b := DestEngine.DirectoryExists(ExcludeTrailingPathDelimiter(s), False) and (not CaseInsensitiveRename); - if (not b) and (s <> '/') then begin - s2 := ExcludeTrailingPathDelimiter(s); - s2 := ExcludeTrailingPathDelimiter(Copy(s2, 1, LastDelimiter('/', s2))); - b := DestEngine.DirectoryExists(ExcludeTrailingPathDelimiter(s2), False); - end; + if not Ren then begin + InputFiles.Add(FullPath); + end else begin + s := ProcessPattern(DestEngine, ParamString1, CurrPath, ParamFileName, ParamDir); + CaseInsensitiveRename := (WideCompareStr(ParamString1, ParamFileName) <> 0) and (WideCompareText(ParamString1, ParamFileName) = 0) and + ParamDir and DestEngine.TwoSameFiles(IncludeTrailingPathDelimiter(CurrPath) + ParamString1, IncludeTrailingPathDelimiter(CurrPath) + ParamFileName, False); +// DebugMsg(['HandleProcessPattern: s = ', s]); + b := False; + if ParamDir then begin + b := DestEngine.DirectoryExists(ExcludeTrailingPathDelimiter(s), False) and (not CaseInsensitiveRename); + if (not b) and (s <> '/') then begin + s2 := ExcludeTrailingPathDelimiter(s); + s2 := ExcludeTrailingPathDelimiter(Copy(s2, 1, LastDelimiter('/', s2))); + b := DestEngine.DirectoryExists(ExcludeTrailingPathDelimiter(s2), False); end; - if (not ParamDir) or (ParamDir and b and IsOnSameFS(ExcludeTrailingPathDelimiter(FullPath), s2)) - then begin - Info := GetFileInfoSL(SrcEngine, FullPath); - if Info = nil then begin - DebugMsg(['$$$ Copy: Something went wrong while building the filelist...']); - ErrorHappened := True; - end else begin - Info^.ADestination := strdup(PChar(s)); - Info^.ForceMove := True; - AList.Add(Info); - end; - end else InputFiles.Add(FullPath); end; - FillDirFiles(SrcEngine, AList, InputFiles, False, True); + if (not ParamDir) or (ParamDir and b and IsOnSameFS(ExcludeTrailingPathDelimiter(FullPath), s2)) + then begin + Info := GetFileInfoSL(SrcEngine, FullPath); + if Info = nil then begin + DebugMsg(['$$$ Copy: Something went wrong while building the filelist...']); + ErrorHappened := True; + end else begin + Info^.ADestination := strdup(PChar(s)); + Info^.ForceMove := True; + AList.Add(Info); + end; + end else InputFiles.Add(FullPath); end; + FillDirFiles(SrcEngine, AList, InputFiles, False, True); InputFiles.Free; end; @@ -1390,143 +1393,141 @@ var i: longint; begin List := TList.Create; List.Clear; - with SenderThread do begin - ErrorHappened := False; - SaveSrcPath := ''; - CurrPath := IncludeTrailingPathDelimiter(SrcEngine.Path); - SaveDestPath := DestEngine.Path; - ParamString1 := ExcludeTrailingPathDelimiter(ParamString1); - if ParamString1 = '' then ParamString1 := PathDelim; - - // Prepare list of files to copy - if ParamBool5 then begin // HandleVFSFromArchive - if not ExtractFromVFSAll then HandleProcessPattern(List, CurrPath, ParamString2, ExtractFileName(ParamString2), False, False) - else begin - SaveSrcPath := IncludeTrailingPathDelimiter(SrcEngine.Path); - SrcEngine.SetPath('/'); - CurrPath := '/'; - HandleProcessPattern(List, '/', '/', '', True, False); - end; - end else - if ParamBool4 then begin // Quick-Rename - with ParamDataItem1^ do - HandleProcessPattern(List, CurrPath, CurrPath + String(FName), String(FName), IsDir and (not IsLnk), True); - end else begin // Not Quick-Rename - if not ExtractFromVFSMode then begin - if DataList.Count > 0 then - for i := 0 to DataList.Count - 1 do - with PDataItem(DataList[i])^ do - if (not UpDir) and Selected - then HandleProcessPattern(List, CurrPath, CurrPath + String(FName), String(FName), IsDir and (not IsLnk), not ParamBool3); - if (List.Count = 0) and Assigned(SelectedItem) and (not SelectedItem^.UpDir) then - with SelectedItem^ do - HandleProcessPattern(List, CurrPath, CurrPath + String(FName), String(FName), IsDir and (not IsLnk), not ParamBool3); - end else begin // Extract from VFS mode - DebugMsg(['CopyFilesWorker: Should not be reached']); - if (not ExtractFromVFSAll) and Assigned(SelectedItem) - then HandleProcessPattern(List, CurrPath, CurrPath + String(SelectedItem^.FName), String(SelectedItem^.FName), SelectedItem^.IsDir and (not SelectedItem^.IsLnk), not ParamBool3) - else begin - SaveSrcPath := IncludeTrailingPathDelimiter(SrcEngine.Path); - SrcEngine.SetPath('/'); - CurrPath := '/'; - HandleProcessPattern(List, '/', '/', '', True, False); - end; + ErrorHappened := False; + SaveSrcPath := ''; + CurrPath := IncludeTrailingPathDelimiter(SrcEngine.Path); + SaveDestPath := DestEngine.Path; + ParamString1 := ExcludeTrailingPathDelimiter(ParamString1); + if ParamString1 = '' then ParamString1 := PathDelim; + + // Prepare list of files to copy + if ParamBool5 then begin // HandleVFSFromArchive + if not ExtractFromVFSAll then HandleProcessPattern(List, CurrPath, ParamString2, ExtractFileName(ParamString2), False, False) + else begin + SaveSrcPath := IncludeTrailingPathDelimiter(SrcEngine.Path); + SrcEngine.SetPath('/'); + CurrPath := '/'; + HandleProcessPattern(List, '/', '/', '', True, False); + end; + end else + if ParamBool4 then begin // Quick-Rename + with ParamDataItem1^ do + HandleProcessPattern(List, CurrPath, CurrPath + String(FName), String(FName), IsDir and (not IsLnk), True); + end else begin // Not Quick-Rename + if not ExtractFromVFSMode then begin + if DataList.Count > 0 then + for i := 0 to DataList.Count - 1 do + with PDataItem(DataList[i])^ do + if (not UpDir) and Selected + then HandleProcessPattern(List, CurrPath, CurrPath + String(FName), String(FName), IsDir and (not IsLnk), not ParamBool3); + if (List.Count = 0) and Assigned(SelectedItem) and (not SelectedItem^.UpDir) then + with SelectedItem^ do + HandleProcessPattern(List, CurrPath, CurrPath + String(FName), String(FName), IsDir and (not IsLnk), not ParamBool3); + end else begin // Extract from VFS mode + DebugMsg(['CopyFilesWorker: Should not be reached']); + if (not ExtractFromVFSAll) and Assigned(SelectedItem) + then HandleProcessPattern(List, CurrPath, CurrPath + String(SelectedItem^.FName), String(SelectedItem^.FName), SelectedItem^.IsDir and (not SelectedItem^.IsLnk), not ParamBool3) + else begin + SaveSrcPath := IncludeTrailingPathDelimiter(SrcEngine.Path); + SrcEngine.SetPath('/'); + CurrPath := '/'; + HandleProcessPattern(List, '/', '/', '', True, False); end; end; + end; -{ if DestEngine.ChangeDir(CurrPath) <> 0 then DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour may occur.']); - if SrcEngine.ChangeDir(CurrPath) <> 0 then DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour may occur.']); } - DebugWriteListSL(List); - - __chdir('/'); - // Compute total size of files to copy - MaxSize := 0; ParamInt64 := 0; - if List.Count > 0 then - for i := 0 to List.Count - 1 do - if PDataItemSL(List[i])^.Stage1 and (PDataItemSL(List[i])^.DataItem^.Size > 0) and (not PDataItemSL(List[i])^.DataItem^.IsDir) and (not PDataItemSL(List[i])^.DataItem^.IsLnk) - then Inc(MaxSize, PDataItemSL(List[i])^.DataItem^.Size); - SrcEngine.BlockSize := ComputeBlockSize(MaxSize); - DestEngine.BlockSize := ComputeBlockSize(MaxSize); - - // Prepare the Progress window - SetProgress2Params(MaxSize + Ord(MaxSize = 0)); - UpdateProgress1(0, '0%'); - UpdateProgress2(0, '0%'); - CommitGUIUpdate; +{ if DestEngine.ChangeDir(CurrPath) <> 0 then DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour may occur.']); + if SrcEngine.ChangeDir(CurrPath) <> 0 then DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour may occur.']); } + DebugWriteListSL(List); - DefResponse := 0; - ParamBool1 := ParamBool3; - SkipAll := False; - ParamBool2 := False; - - if MaxSize < 2 then ParamFloat1 := 1 else ParamFloat1 := 100 / (MaxSize - 1); - if List.Count > 0 then begin - StartPassed := True; - if SrcEngine is TVFSEngine then - StartPassed := StartPassed and (SrcEngine as TVFSEngine).StartCopyOperation(@vfs_ask_question_callback, @vfs_ask_password_callback, @vfs_copy_progress_callback, SenderThread); - if DestEngine is TVFSEngine then - StartPassed := StartPassed and (DestEngine as TVFSEngine).StartCopyOperation(@vfs_ask_question_callback, @vfs_ask_password_callback, @vfs_copy_progress_callback, SenderThread); - - if StartPassed then - for i := 0 to List.Count - 1 do begin - if Assigned(PDataItemSL(List[i])^.ADestination) - then s := string(PDataItemSL(List[i])^.ADestination) - else - begin - s := ProcessPattern(DestEngine, ParamString1, CurrPath, Copy(PDataItemSL(List[i])^.DataItem^.FName, Length(CurrPath) + 1, Length(PDataItemSL(List[i])^.DataItem^.FName) - Length(CurrPath)), - PDataItemSL(List[i])^.DataItem^.IsDir and (not PDataItemSL(List[i])^.DataItem^.IsLnk)); - // DebugMsg(['s2 = ', Copy(PDataItemSL(List[i])^.AName, Length(CurrPath) + 1, Length(PDataItemSL(List[i])^.AName) - Length(CurrPath)), ', s = ', s]); - end; + __chdir('/'); + // Compute total size of files to copy + MaxSize := 0; ParamInt64 := 0; + if List.Count > 0 then + for i := 0 to List.Count - 1 do + if PDataItemSL(List[i])^.Stage1 and (PDataItemSL(List[i])^.DataItem^.Size > 0) and (not PDataItemSL(List[i])^.DataItem^.IsDir) and (not PDataItemSL(List[i])^.DataItem^.IsLnk) + then Inc(MaxSize, PDataItemSL(List[i])^.DataItem^.Size); + SrcEngine.BlockSize := ComputeBlockSize(MaxSize); + DestEngine.BlockSize := ComputeBlockSize(MaxSize); + + // Prepare the Progress window + SetProgress2Params(MaxSize + Ord(MaxSize = 0)); + UpdateProgress1(0, '0%'); + UpdateProgress2(0, '0%'); + CommitGUIUpdate; + + DefResponse := 0; + ParamBool1 := ParamBool3; + SkipAll := False; + ParamBool2 := False; - if not (SrcEngine is TVFSEngine) then UpdateCaption1(Format(LANGFromS, [string(PDataItemSL(List[i])^.DataItem^.FDisplayName)])) else - if (SrcEngine as TVFSEngine).ArchiveMode then UpdateCaption1(Format(LANGFromS, [Format(ConstFullPathFormatStr, [(SrcEngine as TVFSEngine).ArchivePath, string(PDataItemSL(List[i])^.DataItem^.FDisplayName)])])) - else UpdateCaption1(Format(LANGFromS, [GetURIPrefix((SrcEngine as TVFSEngine).GetPathURI) + StrToUTF8(string(PDataItemSL(List[i])^.DataItem^.FDisplayName))])); - if not (DestEngine is TVFSEngine) then UpdateCaption2(Format(LANGToS, [StrToUTF8(s)])) else - if (DestEngine as TVFSEngine).ArchiveMode then UpdateCaption2(Format(LANGToS, [Format(ConstFullPathFormatStr, [(DestEngine as TVFSEngine).ArchivePath, StrToUTF8(s)])])) - else UpdateCaption2(Format(LANGToS, [GetURIPrefix((DestEngine as TVFSEngine).GetPathURI) + StrToUTF8(s)])); - CommitGUIUpdate; - if TwoSameFiles(s, string(PDataItemSL(List[i])^.DataItem^.FName), ParamBool3) and (not PDataItemSL(List[i])^.DataItem^.IsDir) then begin - FCancelMessage := LANGCannotCopyFileToItself; - FShowCancelMessage := True; - ErrorHappened := True; - Break; - end; - // * FIXME: why the hell we had something like this here?? - // if s <> string(PDataItemSL(List[i])^.DataItem^.FName) then - if not HandleCopy(List[i], s) then begin - ErrorHappened := True; - Break; - end; - if (not PDataItemSL(List[i])^.DataItem^.IsDir) and (not PDataItemSL(List[i])^.DataItem^.IsLnk) - then Inc(ParamInt64, PDataItemSL(List[i])^.DataItem^.Size); - if FCancelled then begin - FCancelMessage := LANGUserCancelled; - FShowCancelMessage := True; + if MaxSize < 2 then ParamFloat1 := 1 else ParamFloat1 := 100 / (MaxSize - 1); + if List.Count > 0 then begin + StartPassed := True; + if SrcEngine is TVFSEngine then + StartPassed := StartPassed and (SrcEngine as TVFSEngine).StartCopyOperation(@vfs_ask_question_callback, @vfs_ask_password_callback, @vfs_copy_progress_callback, Self); + if DestEngine is TVFSEngine then + StartPassed := StartPassed and (DestEngine as TVFSEngine).StartCopyOperation(@vfs_ask_question_callback, @vfs_ask_password_callback, @vfs_copy_progress_callback, Self); + + if StartPassed then + for i := 0 to List.Count - 1 do begin + if Assigned(PDataItemSL(List[i])^.ADestination) + then s := string(PDataItemSL(List[i])^.ADestination) + else + begin + s := ProcessPattern(DestEngine, ParamString1, CurrPath, Copy(PDataItemSL(List[i])^.DataItem^.FName, Length(CurrPath) + 1, Length(PDataItemSL(List[i])^.DataItem^.FName) - Length(CurrPath)), + PDataItemSL(List[i])^.DataItem^.IsDir and (not PDataItemSL(List[i])^.DataItem^.IsLnk)); +// DebugMsg(['s2 = ', Copy(PDataItemSL(List[i])^.AName, Length(CurrPath) + 1, Length(PDataItemSL(List[i])^.AName) - Length(CurrPath)), ', s = ', s]); + end; + + if not (SrcEngine is TVFSEngine) then UpdateCaption1(Format(LANGFromS, [string(PDataItemSL(List[i])^.DataItem^.FDisplayName)])) else + if (SrcEngine as TVFSEngine).ArchiveMode then UpdateCaption1(Format(LANGFromS, [Format(ConstFullPathFormatStr, [(SrcEngine as TVFSEngine).ArchivePath, string(PDataItemSL(List[i])^.DataItem^.FDisplayName)])])) + else UpdateCaption1(Format(LANGFromS, [GetURIPrefix((SrcEngine as TVFSEngine).GetPathURI) + StrToUTF8(string(PDataItemSL(List[i])^.DataItem^.FDisplayName))])); + if not (DestEngine is TVFSEngine) then UpdateCaption2(Format(LANGToS, [StrToUTF8(s)])) else + if (DestEngine as TVFSEngine).ArchiveMode then UpdateCaption2(Format(LANGToS, [Format(ConstFullPathFormatStr, [(DestEngine as TVFSEngine).ArchivePath, StrToUTF8(s)])])) + else UpdateCaption2(Format(LANGToS, [GetURIPrefix((DestEngine as TVFSEngine).GetPathURI) + StrToUTF8(s)])); + CommitGUIUpdate; + if TwoSameFiles(s, string(PDataItemSL(List[i])^.DataItem^.FName), ParamBool3) and (not PDataItemSL(List[i])^.DataItem^.IsDir) then begin + FCancelMessage := LANGCannotCopyFileToItself; + FShowCancelMessage := True; + ErrorHappened := True; + Break; + end; +// * FIXME: why the hell we had something like this here?? +// if s <> string(PDataItemSL(List[i])^.DataItem^.FName) then + if not HandleCopy(List[i], s) then begin ErrorHappened := True; Break; end; + if (not PDataItemSL(List[i])^.DataItem^.IsDir) and (not PDataItemSL(List[i])^.DataItem^.IsLnk) + then Inc(ParamInt64, PDataItemSL(List[i])^.DataItem^.Size); + if FCancelled then begin + FCancelMessage := LANGUserCancelled; + FShowCancelMessage := True; + ErrorHappened := True; + Break; end; + end; - // We need to ensure these to be called in case of error - if SrcEngine is TVFSEngine then - (SrcEngine as TVFSEngine).StopCopyOperation(@vfs_copy_progress_callback, SenderThread); - if DestEngine is TVFSEngine then - (DestEngine as TVFSEngine).StopCopyOperation(@vfs_copy_progress_callback, SenderThread); - end; - - // Free the objects - if List.Count > 0 then - for i := List.Count - 1 downto 0 do FreeDataItem(PDataItemSL(List[i])); - List.Clear; - List.Free; - // * TODO: check error - if not DestEngine.ChangeDir(SaveDestPath, nil) then - DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour might occur.']); - if SaveSrcPath <> '' then CurrPath := SaveSrcPath; - // * TODO: check error - if not SrcEngine.ChangeDir(CurrPath, nil) then - DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour might occur.']); + // We need to ensure these to be called in case of error + if SrcEngine is TVFSEngine then + (SrcEngine as TVFSEngine).StopCopyOperation(@vfs_copy_progress_callback, Self); + if DestEngine is TVFSEngine then + (DestEngine as TVFSEngine).StopCopyOperation(@vfs_copy_progress_callback, Self); end; + + // Free the objects + if List.Count > 0 then + for i := List.Count - 1 downto 0 do FreeDataItem(PDataItemSL(List[i])); + List.Clear; + List.Free; + // * TODO: check error + if not DestEngine.ChangeDir(SaveDestPath, nil) then + DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour might occur.']); + if SaveSrcPath <> '' then CurrPath := SaveSrcPath; + // * TODO: check error + if not SrcEngine.ChangeDir(CurrPath, nil) then + DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour might occur.']); DebugMsg(['(II) CopyFilesWorker: finished']); end; @@ -1535,7 +1536,7 @@ end; (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) -procedure MergeFilesWorker(SenderThread: TWorkerThread); +procedure TWorkerThread.MergeFilesWorker; // ParamBool1 = HasInitialCRC // ParamString1 = NewPath // ParamString2 = FileName @@ -1559,45 +1560,43 @@ var FD: TEngineFileDes; Stat: PDataItem; begin Result := False; - with SenderThread do begin - if ParamBool1 then UpdateCaption2(Format(LANGToS, [StrToUTF8(FName)])) - else UpdateCaption1(Format(LANGFromS, [StrToUTF8(FName)])); - UpdateProgress1(0, '0 %'); - CommitGUIUpdate; + if ParamBool1 then UpdateCaption2(Format(LANGToS, [StrToUTF8(FName)])) + else UpdateCaption1(Format(LANGFromS, [StrToUTF8(FName)])); + UpdateProgress1(0, '0 %'); + CommitGUIUpdate; + // * TODO: check error + Stat := Engine.GetFileInfo(FName, True, True, nil); + if not Assigned(Stat) then Exit; + SetProgress1Params(Stat^.Size); + FreeDataItem(Stat); + // * TODO: check error + Error := nil; + FDR := Engine.OpenFile(FName, omRead, @Error); + if FDR = nil then Exit; + repeat // * TODO: check error - Stat := Engine.GetFileInfo(FName, True, True, nil); - if not Assigned(Stat) then Exit; - SetProgress1Params(Stat^.Size); - FreeDataItem(Stat); + Count := Engine.ReadFile(FDR, Buffer, MergeBlockSize, @Error); + if Error <> nil then begin + Engine.CloseFile(FD, nil); + Exit; + end; // * TODO: check error - Error := nil; - FDR := Engine.OpenFile(FName, omRead, @Error); - if FDR = nil then Exit; - repeat - // * TODO: check error - Count := Engine.ReadFile(FDR, Buffer, MergeBlockSize, @Error); - if Error <> nil then begin - Engine.CloseFile(FD, nil); - Exit; - end; - // * TODO: check error - wCount := Engine.WriteFile(FD, Buffer, Count, @Error); - if (Error <> nil) or (Count <> wCount) then begin - FCancelMessage := Format(LANGAnErrorOccuredWhileWritingFileSS, [ExtractFileName(TargetName), Error^.message]); - FShowCancelMessage := True; - PrivateCancel := True; - Result := True; // Fake this to don't show next disc dialog - Exit; - end; - CurrentCRC := CRC32(CurrentCRC, Buffer, Count); - UpdateProgress1(FProgress1Pos + Count, Format('%d %%', [Trunc((FProgress1Pos + Count) / FProgress1Max * 100)])); - Inc(SizeDone, Count); - if ParamBool1 then UpdateProgress2(SizeDone, Format('%d %%', [Trunc(SizeDone / FProgress2Max * 100)])); - CommitGUIUpdate; - until (Count < MergeBlockSize) or FCancelled; - // * TODO: set real error, also free it - Engine.CloseFile(FDR, nil); - end; + wCount := Engine.WriteFile(FD, Buffer, Count, @Error); + if (Error <> nil) or (Count <> wCount) then begin + FCancelMessage := Format(LANGAnErrorOccuredWhileWritingFileSS, [ExtractFileName(TargetName), Error^.message]); + FShowCancelMessage := True; + PrivateCancel := True; + Result := True; // Fake this to don't show next disc dialog + Exit; + end; + CurrentCRC := CRC32(CurrentCRC, Buffer, Count); + UpdateProgress1(FProgress1Pos + Count, Format('%d %%', [Trunc((FProgress1Pos + Count) / FProgress1Max * 100)])); + Inc(SizeDone, Count); + if ParamBool1 then UpdateProgress2(SizeDone, Format('%d %%', [Trunc(SizeDone / FProgress2Max * 100)])); + CommitGUIUpdate; + until (Count < MergeBlockSize) or FCancelled; + // * TODO: set real error, also free it + Engine.CloseFile(FDR, nil); Result := True; end; @@ -1606,95 +1605,93 @@ var CurrFile, SourcePath, TargetFinalName: string; HasFinalCRC, b: boolean; Stat: PDataItem; begin - with SenderThread do begin - HasFinalCRC := ParamBool1; - TargetFinalName := ParamString3; - if (Length(ParamString2) > 4) and (WideUpperCase(RightStr(ParamString2, 4)) = '.CRC') - then CurrFile := ChangeFileExt(ExtractFileName(ParamString2), '.001') - else CurrFile := ExtractFileName(ParamString2); - SourcePath := ExtractFilePath(ParamString2); - if ParamString3 = '' then ParamString3 := ChangeFileExt(ExtractFileName(ParamString2), '.out'); - TargetName := ProcessPattern(Engine, ParamString1, Engine.Path, ParamString3, False); - if Engine.FileExists(TargetName, False) then - if ShowMessageBox(Format(LANGTheTargetFileSAlreadyExistsDoYouWantToOverwriteIt, [StrToUTF8(TargetName)]), [mbYes, mbNo], mbQuestion, mbNone, mbNo) = mbYes then - begin - // * TODO: check error -{ Error := Ord(Engine.Remove(TargetName, nil)); - if Error <> 0 then begin - FCancelMessage := Format(LANGTheTargetFileSCannotBeRemovedS, [StrToUTF8(ExtractFileName(TargetName)), GetErrorString(Error)]); - FShowCancelMessage := True; - Exit; - end; } - end else Exit; + HasFinalCRC := ParamBool1; + TargetFinalName := ParamString3; + if (Length(ParamString2) > 4) and (WideUpperCase(RightStr(ParamString2, 4)) = '.CRC') + then CurrFile := ChangeFileExt(ExtractFileName(ParamString2), '.001') + else CurrFile := ExtractFileName(ParamString2); + SourcePath := ExtractFilePath(ParamString2); + if ParamString3 = '' then ParamString3 := ChangeFileExt(ExtractFileName(ParamString2), '.out'); + TargetName := ProcessPattern(Engine, ParamString1, Engine.Path, ParamString3, False); + if Engine.FileExists(TargetName, False) then + if ShowMessageBox(Format(LANGTheTargetFileSAlreadyExistsDoYouWantToOverwriteIt, [StrToUTF8(TargetName)]), [mbYes, mbNo], mbQuestion, mbNone, mbNo) = mbYes then + begin + // * TODO: check error +{ Error := Ord(Engine.Remove(TargetName, nil)); + if Error <> 0 then begin + FCancelMessage := Format(LANGTheTargetFileSCannotBeRemovedS, [StrToUTF8(ExtractFileName(TargetName)), GetErrorString(Error)]); + FShowCancelMessage := True; + Exit; + end; } + end else Exit; - // * TODO: check error - Stat := Engine.GetFileInfo(ParamString2, True, True, nil); - if Assigned(Stat) then MergeBlockSize := ComputeBlockSize(Stat^.Size) - else MergeBlockSize := 65536*4; - FreeDataItem(Stat); - try - Buffer := malloc(MergeBlockSize); - memset(Buffer, 0, MergeBlockSize); - except - FCancelMessage := LANGAnErrorOccuredWhileInitializingMemoryBlock; - FShowCancelMessage := True; - Exit; - end; - // * TODO: check error - FD := Engine.OpenFile(TargetName, omWrite, @Error); - if Error <> nil then begin - FCancelMessage := Format(LANGAnErrorOccuredWhileOpeningFileSS, [StrToUTF8(TargetName), Error^.message]); - FShowCancelMessage := True; - libc_free(Buffer); - Exit; - end; + // * TODO: check error + Stat := Engine.GetFileInfo(ParamString2, True, True, nil); + if Assigned(Stat) then MergeBlockSize := ComputeBlockSize(Stat^.Size) + else MergeBlockSize := 65536*4; + FreeDataItem(Stat); + try + Buffer := malloc(MergeBlockSize); + memset(Buffer, 0, MergeBlockSize); + except + FCancelMessage := LANGAnErrorOccuredWhileInitializingMemoryBlock; + FShowCancelMessage := True; + Exit; + end; + // * TODO: check error + FD := Engine.OpenFile(TargetName, omWrite, @Error); + if Error <> nil then begin + FCancelMessage := Format(LANGAnErrorOccuredWhileOpeningFileSS, [StrToUTF8(TargetName), Error^.message]); + FShowCancelMessage := True; + libc_free(Buffer); + Exit; + end; - CurrentCRC := 0; - SizeDone := 0; - PrivateCancel := False; - if ParamBool1 then begin - SetProgress2Params(ParamInt64); - UpdateProgress2(0, '0 %'); - UpdateCaption2(Format(LANGFromS, [StrToUTF8(TargetName)])); - CommitGUIUpdate; - end; { else begin - Label2.XAlign := 0; - Label2.XPadding := 20; - end; } + CurrentCRC := 0; + SizeDone := 0; + PrivateCancel := False; + if ParamBool1 then begin + SetProgress2Params(ParamInt64); + UpdateProgress2(0, '0 %'); + UpdateCaption2(Format(LANGFromS, [StrToUTF8(TargetName)])); + CommitGUIUpdate; + end; { else begin + Label2.XAlign := 0; + Label2.XPadding := 20; + end; } - repeat - b := PasteFile(IncludeTrailingPathDelimiter(SourcePath) + CurrFile); - if not b then begin - PrivateCancel := ShowNewDirDialog(LANGMergeCaption, LANGPleaseInsertNextDiskOrGiveDifferentLocation, StrToUTF8(SourcePath)) <> integer(mbOK); - if not PrivateCancel then begin - SourcePath := UTF8ToStr(FNewDirEdit); - if not HasFinalCRC then - HasFinalCRC := CRCGetInfo(IncludeTrailingPathDelimiter(SourcePath) + CurrFile, Engine, TargetFinalName, ParamLongWord1, ParamInt64); - Continue; - end; - end; - try - CurrFile := Copy(CurrFile, 1, LastDelimiter('.', CurrFile)) + Format('%.3d', [StrToInt( - Copy(CurrFile, LastDelimiter('.', CurrFile) + 1, Length(CurrFile) - LastDelimiter('.', CurrFile))) + 1]); - except - CurrFile := ''; + repeat + b := PasteFile(IncludeTrailingPathDelimiter(SourcePath) + CurrFile); + if not b then begin + PrivateCancel := ShowNewDirDialog(LANGMergeCaption, LANGPleaseInsertNextDiskOrGiveDifferentLocation, StrToUTF8(SourcePath)) <> integer(mbOK); + if not PrivateCancel then begin + SourcePath := UTF8ToStr(FNewDirEdit); + if not HasFinalCRC then + HasFinalCRC := CRCGetInfo(IncludeTrailingPathDelimiter(SourcePath) + CurrFile, Engine, TargetFinalName, ParamLongWord1, ParamInt64); + Continue; end; - until (SizeDone = ParamInt64) or FCancelled or PrivateCancel {or ((not b) and (not HasInitialCRC))} or (CurrFile = ''); - // * TODO: check error - if (not ParamBool1) and HasFinalCRC then Engine.RenameFile(TargetName, IncludeTrailingPathDelimiter(ExtractFilePath(TargetName)) + TargetFinalName, nil); - if FCancelled and (not PrivateCancel) then begin - FCancelMessage := LANGUserCancelled; - FShowCancelMessage := True; end; - if not (FCancelled or PrivateCancel) then - if HasFinalCRC then begin - if CurrentCRC = ParamLongWord1 - then ShowMessageBox(Format(LANGMergeOfSSucceeded, [StrToUTF8(ExtractFileName(TargetFinalName))]), [mbOK], mbInfo, mbNone, mbOK) - else ShowMessageBox(LANGWarningCreatedFileFailsCRCCheck, [mbOK], mbWarning, mbNone, mbOK); - end else ShowMessageBox(Format(LANGMergeOfSSucceeded_NoCRCFileAvailable, [StrToUTF8(ExtractFileName(TargetFinalName))]), [mbOK], mbInfo, mbNone, mbOK); - // * TODO: set real error, also free it - Engine.CloseFile(FD, nil); + try + CurrFile := Copy(CurrFile, 1, LastDelimiter('.', CurrFile)) + Format('%.3d', [StrToInt( + Copy(CurrFile, LastDelimiter('.', CurrFile) + 1, Length(CurrFile) - LastDelimiter('.', CurrFile))) + 1]); + except + CurrFile := ''; + end; + until (SizeDone = ParamInt64) or FCancelled or PrivateCancel {or ((not b) and (not HasInitialCRC))} or (CurrFile = ''); + // * TODO: check error + if (not ParamBool1) and HasFinalCRC then Engine.RenameFile(TargetName, IncludeTrailingPathDelimiter(ExtractFilePath(TargetName)) + TargetFinalName, nil); + if FCancelled and (not PrivateCancel) then begin + FCancelMessage := LANGUserCancelled; + FShowCancelMessage := True; end; + if not (FCancelled or PrivateCancel) then + if HasFinalCRC then begin + if CurrentCRC = ParamLongWord1 + then ShowMessageBox(Format(LANGMergeOfSSucceeded, [StrToUTF8(ExtractFileName(TargetFinalName))]), [mbOK], mbInfo, mbNone, mbOK) + else ShowMessageBox(LANGWarningCreatedFileFailsCRCCheck, [mbOK], mbWarning, mbNone, mbOK); + end else ShowMessageBox(Format(LANGMergeOfSSucceeded_NoCRCFileAvailable, [StrToUTF8(ExtractFileName(TargetFinalName))]), [mbOK], mbInfo, mbNone, mbOK); + // * TODO: set real error, also free it + Engine.CloseFile(FD, nil); libc_free(Buffer); end; @@ -1703,7 +1700,7 @@ end; (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) -procedure SplitFilesWorker(SenderThread: TWorkerThread); +procedure TWorkerThread.SplitFilesWorker; // ParamInt64 = SplitSize // ParamString1 = FileName // ParamString2 = NewPath @@ -1725,50 +1722,48 @@ var FD: TEngineFileDes; begin Result := False; Written := 0; - with SenderThread do begin + // * TODO: check error + FDW := Engine.OpenFile(TargetFile, omWrite, @Error); + DebugMsg(['-- Opening file ', ExtractFileName(TargetFile), ', PartSize = ', PartSize]); + if Error <> nil then Exit; + if ParamInt64 > 0 then begin + UpdateCaption2(Format(LANGToS, [StrToUTF8(TargetFile)])); + SetProgress1Params(PartSize); + UpdateProgress1(0, '0 %'); + end else UpdateCaption1(Format(LANGToS, [StrToUTF8(TargetFile)])); + CommitGUIUpdate; + repeat // * TODO: check error - FDW := Engine.OpenFile(TargetFile, omWrite, @Error); - DebugMsg(['-- Opening file ', ExtractFileName(TargetFile), ', PartSize = ', PartSize]); - if Error <> nil then Exit; - if ParamInt64 > 0 then begin - UpdateCaption2(Format(LANGToS, [StrToUTF8(TargetFile)])); - SetProgress1Params(PartSize); - UpdateProgress1(0, '0 %'); - end else UpdateCaption1(Format(LANGToS, [StrToUTF8(TargetFile)])); - CommitGUIUpdate; - repeat - // * TODO: check error - DebugMsg(['Seek to ', Engine.FileSeek(FD, SizeDone + Written, @Error), ', Written = ', Written]); - if Written + SplitBlockSize > PartSize then bl := PartSize - Written - else bl := SplitBlockSize; - // * TODO: check error - Count := Engine.ReadFile(FD, Buffer, bl, @Error); - if (Error <> nil) or (Count <> bl) then begin - // * TODO: set real error, also free it - Engine.CloseFile(FDW, nil); - DebugMsg(['Read Error: ', Error^.message, ', Count = ', Count, ', bl = ', bl]); -// if (Count <> bl) and (Error = 0) then Error := EIO; - Exit; - end; + DebugMsg(['Seek to ', Engine.FileSeek(FD, SizeDone + Written, @Error), ', Written = ', Written]); + if Written + SplitBlockSize > PartSize then bl := PartSize - Written + else bl := SplitBlockSize; + // * TODO: check error + Count := Engine.ReadFile(FD, Buffer, bl, @Error); + if (Error <> nil) or (Count <> bl) then begin + // * TODO: set real error, also free it + Engine.CloseFile(FDW, nil); + DebugMsg(['Read Error: ', Error^.message, ', Count = ', Count, ', bl = ', bl]); +// if (Count <> bl) and (Error = 0) then Error := EIO; + Exit; + end; + // * TODO: check error + wCount := Engine.WriteFile(FDW, Buffer, Count, @Error); + Inc(Written, wCount); + FileCRC := CRC32(FileCRC, Buffer, wCount); + if (Error <> nil) or (Count <> wCount) then begin + // * TODO: set real error, also free it + Engine.CloseFile(FDW, nil); // * TODO: check error - wCount := Engine.WriteFile(FDW, Buffer, Count, @Error); - Inc(Written, wCount); - FileCRC := CRC32(FileCRC, Buffer, wCount); - if (Error <> nil) or (Count <> wCount) then begin - // * TODO: set real error, also free it - Engine.CloseFile(FDW, nil); - // * TODO: check error - DebugMsg(['Write Error: ', Error^.message, ', Count = ', Count, ', wCount = ', wCount]); -// if (wCount <> Count) and (Error = 0) then Error := ENOSPC; - Exit; - end; - UpdateProgress1(FProgress1Pos + wCount, Format('%d %%', [Trunc((FProgress1Pos + wCount) / FProgress1Max * 100)])); - if ParamInt64 > 0 then UpdateProgress2(FProgress2Pos + wCount, Format('%d %%', [Trunc((FProgress2Pos + wCount) / FProgress2Max * 100)])); - CommitGUIUpdate; - until (Written = PartSize) or FCancelled or PrivateCancel; - // * TODO: set real error, also free it - Engine.CloseFile(FDW, nil); - end; + DebugMsg(['Write Error: ', Error^.message, ', Count = ', Count, ', wCount = ', wCount]); +// if (wCount <> Count) and (Error = 0) then Error := ENOSPC; + Exit; + end; + UpdateProgress1(FProgress1Pos + wCount, Format('%d %%', [Trunc((FProgress1Pos + wCount) / FProgress1Max * 100)])); + if ParamInt64 > 0 then UpdateProgress2(FProgress2Pos + wCount, Format('%d %%', [Trunc((FProgress2Pos + wCount) / FProgress2Max * 100)])); + CommitGUIUpdate; + until (Written = PartSize) or FCancelled or PrivateCancel; + // * TODO: set real error, also free it + Engine.CloseFile(FDW, nil); DebugMsg(['-- Closing file ', ExtractFileName(TargetFile), ', PartSize = ', PartSize, ', Written = ', Written]); Result := True; end; @@ -1779,23 +1774,21 @@ var FD: TEngineFileDes; xx: string; begin Result := False; - with SenderThread do begin - Engine.GetFileSystemInfo(FilePath, x, TDF, xx); - // Calculate part size - if ParamInt64 = 0 then begin - if FileSize - SizeDone > TDF then CurrSize := TDF - else CurrSize := FileSize - SizeDone; - end else - if SizeDone + ParamInt64 > FileSize then CurrSize := FileSize - SizeDone - else CurrSize := ParamInt64; - if (TDF < 512) {or (CurrSize < 512)} or (TDF < CurrSize) then begin - DebugMsg(['-- New disk question']); - libc_chdir('/'); - PrivateCancel := ShowNewDirDialog(LANGSplitCaption, LANGPleaseInsertNextDiskOrGiveDifferentLocation, - StrToUTF8(FilePath)) <> integer(mbOK); - if not PrivateCancel then FilePath := UTF8ToStr(FNewDirEdit); - Result := PrivateCancel; - end; + Engine.GetFileSystemInfo(FilePath, x, TDF, xx); + // Calculate part size + if ParamInt64 = 0 then begin + if FileSize - SizeDone > TDF then CurrSize := TDF + else CurrSize := FileSize - SizeDone; + end else + if SizeDone + ParamInt64 > FileSize then CurrSize := FileSize - SizeDone + else CurrSize := ParamInt64; + if (TDF < 512) {or (CurrSize < 512)} or (TDF < CurrSize) then begin + DebugMsg(['-- New disk question']); + libc_chdir('/'); + PrivateCancel := ShowNewDirDialog(LANGSplitCaption, LANGPleaseInsertNextDiskOrGiveDifferentLocation, + StrToUTF8(FilePath)) <> integer(mbOK); + if not PrivateCancel then FilePath := UTF8ToStr(FNewDirEdit); + Result := PrivateCancel; end; end; @@ -1809,145 +1802,143 @@ var i: integer; x: Int64; xx: string; begin - with SenderThread do begin - // * TODO: check error - Stat := Engine.GetFileInfo(ParamString1, True, True, nil); - if not Assigned(Stat) then begin - FCancelMessage := Format(LANGCannotOpenFileS, [StrToUTF8(ParamString1)]); - FShowCancelMessage := True; - Exit; - end; - if (ParamInt64 > 0) and (Stat^.Size > ParamInt64 * 999) then begin - FCancelMessage := LANGCannotSplitTheFileToMoreThan999Parts; - FShowCancelMessage := True; - Exit; - end; - FileSize := Stat^.Size; - FreeDataItem(Stat); - SizeDone := 0; - FileCRC := 0; - List := TList.Create; - - try - Buffer := malloc(SplitBlockSize); - memset(Buffer, 0, SplitBlockSize); - except - FCancelMessage := LANGAnErrorOccuredWhileInitializingMemoryBlock; - FShowCancelMessage := True; - Exit; - end; - // * TODO: check error - FD := Engine.OpenFile(ParamString1, omRead, @Error); - if Error <> nil then begin - FCancelMessage := Format(LANGAnErrorOccuredWhileOpeningFileSS, [StrToUTF8(ParamString1), Error^.message]); - libc_free(Buffer); - Exit; - end; - FilePath := IncludeTrailingPathDelimiter(ProcessPattern(Engine, ParamString2, Engine.Path, '', True)); - FileName := ExtractFileName(ParamString1); - OriginalFName := FileName; - if Pos('.', FileName) > 1 then FileName := ChangeFileExt(FileName, '.001') - else FileName := FileName + '.001'; - PrivateCancel := False; + // * TODO: check error + Stat := Engine.GetFileInfo(ParamString1, True, True, nil); + if not Assigned(Stat) then begin + FCancelMessage := Format(LANGCannotOpenFileS, [StrToUTF8(ParamString1)]); + FShowCancelMessage := True; + Exit; + end; + if (ParamInt64 > 0) and (Stat^.Size > ParamInt64 * 999) then begin + FCancelMessage := LANGCannotSplitTheFileToMoreThan999Parts; + FShowCancelMessage := True; + Exit; + end; + FileSize := Stat^.Size; + FreeDataItem(Stat); + SizeDone := 0; + FileCRC := 0; + List := TList.Create; - if ParamInt64 > 0 then begin - SetProgress2Params(FileSize); - UpdateProgress2(0, '0 %'); - end else begin - SetProgress1Params(FileSize); - UpdateProgress1(0, '0 %'); - end; - UpdateCaption1(Format(LANGFromS, [StrToUTF8(IncludeTrailingPathDelimiter(FilePath) + OriginalFName)])); - CommitGUIUpdate; + try + Buffer := malloc(SplitBlockSize); + memset(Buffer, 0, SplitBlockSize); + except + FCancelMessage := LANGAnErrorOccuredWhileInitializingMemoryBlock; + FShowCancelMessage := True; + Exit; + end; + // * TODO: check error + FD := Engine.OpenFile(ParamString1, omRead, @Error); + if Error <> nil then begin + FCancelMessage := Format(LANGAnErrorOccuredWhileOpeningFileSS, [StrToUTF8(ParamString1), Error^.message]); + libc_free(Buffer); + Exit; + end; + FilePath := IncludeTrailingPathDelimiter(ProcessPattern(Engine, ParamString2, Engine.Path, '', True)); + FileName := ExtractFileName(ParamString1); + OriginalFName := FileName; + if Pos('.', FileName) > 1 then FileName := ChangeFileExt(FileName, '.001') + else FileName := FileName + '.001'; + PrivateCancel := False; + + if ParamInt64 > 0 then begin + SetProgress2Params(FileSize); + UpdateProgress2(0, '0 %'); + end else begin + SetProgress1Params(FileSize); + UpdateProgress1(0, '0 %'); + end; + UpdateCaption1(Format(LANGFromS, [StrToUTF8(IncludeTrailingPathDelimiter(FilePath) + OriginalFName)])); + CommitGUIUpdate; - repeat - Engine.GetFileSystemInfo(FilePath, x, TDF, xx); - // Delete target files if necessary - if ParamBool1 and ((TDF < 512) or (TDF < FileSize) or (TDF < ParamInt64)) then try - if List.Count > 0 then - for i := List.Count - 1 downto 0 do - FreeDataItem(PDataItem(List[i])); - List.Clear; + repeat + Engine.GetFileSystemInfo(FilePath, x, TDF, xx); + // Delete target files if necessary + if ParamBool1 and ((TDF < 512) or (TDF < FileSize) or (TDF < ParamInt64)) then try + if List.Count > 0 then + for i := List.Count - 1 downto 0 do + FreeDataItem(PDataItem(List[i])); + List.Clear; + // * TODO: check error +{ Error := Engine.GetListing(List, FilePath, ConfShowDotFiles, False, False, nil); + if (Error = 0) and (List.Count > 0) then begin + st := ''; + if List.Count < 6 then begin + for i := 0 to List.Count - 1 do + st := st + ' ' + string(PDataItem(List[i])^.FDisplayName) + #10; + b := ShowMessageBox(Format(LANGThereAreSomeFilesInTheTargetDirectorySDoYouWantToDeleteThem, [StrToUTF8(st)]), [mbYes, mbNo], mbQuestion, mbNone, mbNo) = mbYes; + end else b := ShowMessageBox(Format(LANGThereAreDFilesInTheTargetDirectoryDoYouWantToDeleteThem, [List.Count]), [mbYes, mbNo], mbQuestion, mbNone, mbNo) = mbYes; + if b then + for i := 0 to List.Count - 1 do begin + Error := Engine.Remove(IncludeTrailingPathDelimiter(FilePath) + string(PDataItem(List[i])^.FName)); + if Error <> 0 then ShowMessageBox(Format(LANGTheTargetFileSCannotBeRemovedS, [StrToUTF8(IncludeTrailingPathDelimiter(FilePath)) + string(PDataItem(List[i])^.FDisplayName), GetErrorString(Error)]), [mbOK], mbError, mbNone, mbOK); + end; + end; } + except end; + // Test for target file existence + if Engine.FileExists(IncludeTrailingPathDelimiter(FilePath) + FileName, False) then begin + b := ShowMessageBox(Format(LANGTheTargetFileSAlreadyExistsDoYouWantToOverwriteIt, [StrToUTF8(IncludeTrailingPathDelimiter(FilePath) + FileName)]), [mbYes, mbNo], mbQuestion, mbNone, mbNo) = mbYes; + if b then begin // * TODO: check error -{ Error := Engine.GetListing(List, FilePath, ConfShowDotFiles, False, False, nil); - if (Error = 0) and (List.Count > 0) then begin - st := ''; - if List.Count < 6 then begin - for i := 0 to List.Count - 1 do - st := st + ' ' + string(PDataItem(List[i])^.FDisplayName) + #10; - b := ShowMessageBox(Format(LANGThereAreSomeFilesInTheTargetDirectorySDoYouWantToDeleteThem, [StrToUTF8(st)]), [mbYes, mbNo], mbQuestion, mbNone, mbNo) = mbYes; - end else b := ShowMessageBox(Format(LANGThereAreDFilesInTheTargetDirectoryDoYouWantToDeleteThem, [List.Count]), [mbYes, mbNo], mbQuestion, mbNone, mbNo) = mbYes; - if b then - for i := 0 to List.Count - 1 do begin - Error := Engine.Remove(IncludeTrailingPathDelimiter(FilePath) + string(PDataItem(List[i])^.FName)); - if Error <> 0 then ShowMessageBox(Format(LANGTheTargetFileSCannotBeRemovedS, [StrToUTF8(IncludeTrailingPathDelimiter(FilePath)) + string(PDataItem(List[i])^.FDisplayName), GetErrorString(Error)]), [mbOK], mbError, mbNone, mbOK); - end; - end; } - except end; - // Test for target file existence - if Engine.FileExists(IncludeTrailingPathDelimiter(FilePath) + FileName, False) then begin - b := ShowMessageBox(Format(LANGTheTargetFileSAlreadyExistsDoYouWantToOverwriteIt, [StrToUTF8(IncludeTrailingPathDelimiter(FilePath) + FileName)]), [mbYes, mbNo], mbQuestion, mbNone, mbNo) = mbYes; - if b then begin - // * TODO: check error -{ Error := Engine.Remove(IncludeTrailingPathDelimiter(FilePath) + FileName); - if Error <> 0 then begin - FCancelMessage := Format(LANGTheTargetFileSCannotBeRemovedS, [StrToUTF8(IncludeTrailingPathDelimiter(FilePath) + FileName), GetErrorString(Error)]); - FShowCancelMessage := True; - PrivateCancel := True; - Break; - end; } - end else begin - PrivateCancel := True; - Break; - end; - end; - // Free space check - if NewDiskQuestion then Break; - // Writing - ws := 0; - if (CurrSize >= 512) and (TDF >= CurrSize) then begin - b := WriteSplitPart(IncludeTrailingPathDelimiter(FilePath) + FileName, CurrSize, ws); - if (not b) and (ParamInt64 > 0) then begin - FCancelMessage := Format(LANGAnErrorOccuredWhileOperationS, [Error^.message]); +{ Error := Engine.Remove(IncludeTrailingPathDelimiter(FilePath) + FileName); + if Error <> 0 then begin + FCancelMessage := Format(LANGTheTargetFileSCannotBeRemovedS, [StrToUTF8(IncludeTrailingPathDelimiter(FilePath) + FileName), GetErrorString(Error)]); FShowCancelMessage := True; PrivateCancel := True; Break; - end; - Inc(SizeDone, ws); - if ParamInt64 > 0 then UpdateProgress2(SizeDone, Format('%d %%', [Trunc(SizeDone / FileSize * 100)])) - else UpdateProgress1(SizeDone, Format('%d %%', [Trunc(SizeDone / FileSize * 100)])); - CommitGUIUpdate; + end; } + end else begin + PrivateCancel := True; + Break; end; - // Free space check - New disk question after operation - if NewDiskQuestion then Break; - // Change filename - if ws > 0 then - try FileName := Copy(FileName, 1, LastDelimiter('.', FileName)) + - Format('%.3d', [StrToInt(Copy(FileName, LastDelimiter('.', FileName) + 1, - Length(FileName) - LastDelimiter('.', FileName))) + 1]); - except - FileName := ''; - end; - until (SizeDone = FileSize) or FCancelled or PrivateCancel or (FileName = ''); - if FCancelled and (not PrivateCancel) then begin - FCancelMessage := LANGUserCancelled; - FShowCancelMessage := True; end; - if not (FCancelled or PrivateCancel) then begin - repeat - Engine.GetFileSystemInfo(FilePath, x, TDF, xx); - if (TDF < 512) and (not NewDiskQuestion) then Break; - until (TDF >= 512) or PrivateCancel or FCancelled; - if WriteCRCFile(SenderThread.DialogsParentWindow, Engine, IncludeTrailingPathDelimiter(FilePath) + FileName, OriginalFName, SizeDone, FileCRC) - then ShowMessageBox(Format(LANGSplitOfSSucceeded, [StrToUTF8(OriginalFName)]), [mbOK], mbInfo, mbNone, mbOK) - else begin - FCancelMessage := Format(LANGSplitOfSFailed, [StrToUTF8(OriginalFName)]); - FShowCancelMessage := True; - end; + // Free space check + if NewDiskQuestion then Break; + // Writing + ws := 0; + if (CurrSize >= 512) and (TDF >= CurrSize) then begin + b := WriteSplitPart(IncludeTrailingPathDelimiter(FilePath) + FileName, CurrSize, ws); + if (not b) and (ParamInt64 > 0) then begin + FCancelMessage := Format(LANGAnErrorOccuredWhileOperationS, [Error^.message]); + FShowCancelMessage := True; + PrivateCancel := True; + Break; + end; + Inc(SizeDone, ws); + if ParamInt64 > 0 then UpdateProgress2(SizeDone, Format('%d %%', [Trunc(SizeDone / FileSize * 100)])) + else UpdateProgress1(SizeDone, Format('%d %%', [Trunc(SizeDone / FileSize * 100)])); + CommitGUIUpdate; end; - // * TODO: set real error, also free it - Engine.CloseFile(FD, nil); + // Free space check - New disk question after operation + if NewDiskQuestion then Break; + // Change filename + if ws > 0 then + try FileName := Copy(FileName, 1, LastDelimiter('.', FileName)) + + Format('%.3d', [StrToInt(Copy(FileName, LastDelimiter('.', FileName) + 1, + Length(FileName) - LastDelimiter('.', FileName))) + 1]); + except + FileName := ''; + end; + until (SizeDone = FileSize) or FCancelled or PrivateCancel or (FileName = ''); + if FCancelled and (not PrivateCancel) then begin + FCancelMessage := LANGUserCancelled; + FShowCancelMessage := True; end; + if not (FCancelled or PrivateCancel) then begin + repeat + Engine.GetFileSystemInfo(FilePath, x, TDF, xx); + if (TDF < 512) and (not NewDiskQuestion) then Break; + until (TDF >= 512) or PrivateCancel or FCancelled; + if WriteCRCFile(DialogsParentWindow, Engine, IncludeTrailingPathDelimiter(FilePath) + FileName, OriginalFName, SizeDone, FileCRC) + then ShowMessageBox(Format(LANGSplitOfSSucceeded, [StrToUTF8(OriginalFName)]), [mbOK], mbInfo, mbNone, mbOK) + else begin + FCancelMessage := Format(LANGSplitOfSFailed, [StrToUTF8(OriginalFName)]); + FShowCancelMessage := True; + end; + end; + // * TODO: set real error, also free it + Engine.CloseFile(FD, nil); if List.Count > 0 then for i := List.Count - 1 downto 0 do FreeDataItem(PDataItem(List[i])); @@ -1959,7 +1950,7 @@ end; (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) -procedure ChmodFilesWorker(SenderThread: TWorkerThread); +procedure TWorkerThread.ChmodFilesWorker; // ParamBool1 = Recursive // ParamInt1 = All/Dir/Files // ParamCardinal1 = Mode @@ -1971,31 +1962,29 @@ var SkipAll: boolean; Res: boolean; begin Result := True; - with SenderThread do begin -// DebugMsg(['Chmod Debug: IsDir: ', AFileRec^.IsDir, ', Stage1: ', AFileRec^.Stage1, ', IsLnk: ', AFileRec^.IsLnk, '; Result = ', AFileRec^.IsDir and AFileRec^.Stage1 and (not AFileRec^.IsLnk)]); - if AFileRec^.DataItem^.IsDir and ParamBool1 and AFileRec^.Stage1 and (not AFileRec^.DataItem^.IsLnk) then Exit; - if (not AFileRec^.DataItem^.IsDir) and ParamBool1 and (ParamInt1 = 1) then Exit; // Directories only - if AFileRec^.DataItem^.IsDir and ParamBool1 and (ParamInt1 = 2) then Exit; // Files only - // * TODO: check error - Res := Engine.Chmod(String(AFileRec^.DataItem^.FName), ParamCardinal1, nil); -// DebugMsg(['Result : ', Res]); - if not Res then - if SkipAll then Result := True else - begin - // * TODO: check error - Response := ShowDirDeleteDialog(1, LANGTheFileDirectory, String(AFileRec^.DataItem^.FDisplayName), Format(LANGCouldNotBeChmoddedS, - ['ahoj' {GetErrorString(Res)}]), LANGDialogChangePermissions); - case Response of - 1 : Result := True; - 3 : begin - SkipAll := True; - Result := True; - end; - 2 : Result := HandleChmod(AFileRec); - else Result := False; - end; +// DebugMsg(['Chmod Debug: IsDir: ', AFileRec^.IsDir, ', Stage1: ', AFileRec^.Stage1, ', IsLnk: ', AFileRec^.IsLnk, '; Result = ', AFileRec^.IsDir and AFileRec^.Stage1 and (not AFileRec^.IsLnk)]); + if AFileRec^.DataItem^.IsDir and ParamBool1 and AFileRec^.Stage1 and (not AFileRec^.DataItem^.IsLnk) then Exit; + if (not AFileRec^.DataItem^.IsDir) and ParamBool1 and (ParamInt1 = 1) then Exit; // Directories only + if AFileRec^.DataItem^.IsDir and ParamBool1 and (ParamInt1 = 2) then Exit; // Files only + // * TODO: check error + Res := Engine.Chmod(String(AFileRec^.DataItem^.FName), ParamCardinal1, nil); +// DebugMsg(['Result : ', Res]); + if not Res then + if SkipAll then Result := True else + begin + // * TODO: check error + Response := ShowDirDeleteDialog(1, LANGTheFileDirectory, String(AFileRec^.DataItem^.FDisplayName), Format(LANGCouldNotBeChmoddedS, + ['ahoj' {GetErrorString(Res)}]), LANGDialogChangePermissions); + case Response of + 1 : Result := True; + 3 : begin + SkipAll := True; + Result := True; + end; + 2 : Result := HandleChmod(AFileRec); + else Result := False; end; - end; + end; end; var i: longint; @@ -2004,36 +1993,34 @@ var i: longint; begin SkipAll := False; AList := TList.Create; - with SenderThread do begin - PrepareJobFilesFromPanel(AList, not ParamBool1); - libc_chdir('/'); - SetProgress1Params(AList.Count); - UpdateProgress1(0, '0 %'); - CommitGUIUpdate; - -// DebugWriteListSL(AList); - - if AList.Count = 1 then Fr := 1 else Fr := 100 / (AList.Count - 1); - if AList.Count > 0 then - for i := 0 to AList.Count - 1 do begin - if FCancelled then begin - FCancelMessage := LANGUserCancelled; - FShowCancelMessage := True; - Break; - end; - // Process chmod - if not HandleChmod(AList[i]) then Break; - UpdateProgress1(i, Format('%d%%', [Round(Fr * i)])); - UpdateCaption1(PDataItemSL(AList[i])^.DataItem^.FDisplayName); - CommitGUIUpdate; + PrepareJobFilesFromPanel(AList, not ParamBool1); + libc_chdir('/'); + SetProgress1Params(AList.Count); + UpdateProgress1(0, '0 %'); + CommitGUIUpdate; + +// DebugWriteListSL(AList); + + if AList.Count = 1 then Fr := 1 else Fr := 100 / (AList.Count - 1); + if AList.Count > 0 then + for i := 0 to AList.Count - 1 do begin + if FCancelled then begin + FCancelMessage := LANGUserCancelled; + FShowCancelMessage := True; + Break; end; + // Process chmod + if not HandleChmod(AList[i]) then Break; + UpdateProgress1(i, Format('%d%%', [Round(Fr * i)])); + UpdateCaption1(PDataItemSL(AList[i])^.DataItem^.FDisplayName); + CommitGUIUpdate; + end; - // Free the objects - if AList.Count > 0 then - for i := AList.Count - 1 downto 0 do FreeDataItem(PDataItemSL(AList[i])); - AList.Clear; - AList.Free; - end; + // Free the objects + if AList.Count > 0 then + for i := AList.Count - 1 downto 0 do FreeDataItem(PDataItemSL(AList[i])); + AList.Clear; + AList.Free; end; @@ -2041,7 +2028,7 @@ end; (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) -procedure ChownFilesWorker(SenderThread: TWorkerThread); +procedure TWorkerThread.ChownFilesWorker; // ParamBool1 = Recursive // ParamCardinal1 = UID // ParamCardinal2 = GID @@ -2052,30 +2039,28 @@ var SkipAll: boolean; Res: boolean; begin Result := True; - with SenderThread do begin -// DebugMsg(['Chown Debug: IsDir: ', AFileRec^.IsDir, ', Stage1: ', AFileRec^.Stage1, ', IsLnk: ', AFileRec^.IsLnk, '; Result = ', AFileRec^.IsDir and AFileRec^.Stage1 and (not AFileRec^.IsLnk)]); - if (AFileRec^.DataItem^.IsDir and ParamBool1 and AFileRec^.Stage1 and (not AFileRec^.DataItem^.IsLnk)) or - ((not AFileRec^.DataItem^.IsDir) and ParamBool1) then Exit; - // * TODO: check error - Res := Engine.Chown(String(AFileRec^.DataItem^.FName), ParamCardinal1, ParamCardinal2, nil); -// DebugMsg(['Result : ', Res]); - if not Res then - if SkipAll then Result := True else - begin - // * TODO: check error - Response := ShowDirDeleteDialog(1, LANGTheFileDirectory, String(AFileRec^.DataItem^.FDisplayName), Format(LANGCouldNotBeChownedS, - ['ahoj' {GetErrorString(Res)}]), LANGDialogChangeOwner); - case Response of - 1 : Result := True; - 3 : begin - SkipAll := True; - Result := True; - end; - 2 : Result := HandleChown(AFileRec); - else Result := False; - end; +// DebugMsg(['Chown Debug: IsDir: ', AFileRec^.IsDir, ', Stage1: ', AFileRec^.Stage1, ', IsLnk: ', AFileRec^.IsLnk, '; Result = ', AFileRec^.IsDir and AFileRec^.Stage1 and (not AFileRec^.IsLnk)]); + if (AFileRec^.DataItem^.IsDir and ParamBool1 and AFileRec^.Stage1 and (not AFileRec^.DataItem^.IsLnk)) or + ((not AFileRec^.DataItem^.IsDir) and ParamBool1) then Exit; + // * TODO: check error + Res := Engine.Chown(String(AFileRec^.DataItem^.FName), ParamCardinal1, ParamCardinal2, nil); +// DebugMsg(['Result : ', Res]); + if not Res then + if SkipAll then Result := True else + begin + // * TODO: check error + Response := ShowDirDeleteDialog(1, LANGTheFileDirectory, String(AFileRec^.DataItem^.FDisplayName), Format(LANGCouldNotBeChownedS, + ['ahoj' {GetErrorString(Res)}]), LANGDialogChangeOwner); + case Response of + 1 : Result := True; + 3 : begin + SkipAll := True; + Result := True; + end; + 2 : Result := HandleChown(AFileRec); + else Result := False; end; - end; + end; end; var i: longint; @@ -2084,36 +2069,34 @@ var i: longint; begin SkipAll := False; AList := TList.Create; - with SenderThread do begin - PrepareJobFilesFromPanel(AList, not ParamBool1); - libc_chdir('/'); - SetProgress1Params(AList.Count); - UpdateProgress1(0, '0 %'); - CommitGUIUpdate; - -// DebugWriteListSL(AList); - - if AList.Count = 1 then Fr := 1 else Fr := 100 / (AList.Count - 1); - if AList.Count > 0 then - for i := 0 to AList.Count - 1 do begin - if FCancelled then begin - FCancelMessage := LANGUserCancelled; - FShowCancelMessage := True; - Break; - end; - // Process chmod - if not HandleChown(AList[i]) then Break; - UpdateProgress1(i, Format('%d%%', [Round(Fr * i)])); - UpdateCaption1(PDataItemSL(AList[i])^.DataItem^.FDisplayName); - CommitGUIUpdate; + PrepareJobFilesFromPanel(AList, not ParamBool1); + libc_chdir('/'); + SetProgress1Params(AList.Count); + UpdateProgress1(0, '0 %'); + CommitGUIUpdate; + +// DebugWriteListSL(AList); + + if AList.Count = 1 then Fr := 1 else Fr := 100 / (AList.Count - 1); + if AList.Count > 0 then + for i := 0 to AList.Count - 1 do begin + if FCancelled then begin + FCancelMessage := LANGUserCancelled; + FShowCancelMessage := True; + Break; end; + // Process chmod + if not HandleChown(AList[i]) then Break; + UpdateProgress1(i, Format('%d%%', [Round(Fr * i)])); + UpdateCaption1(PDataItemSL(AList[i])^.DataItem^.FDisplayName); + CommitGUIUpdate; + end; - // Free the objects - if AList.Count > 0 then - for i := AList.Count - 1 downto 0 do FreeDataItem(PDataItemSL(AList[i])); - AList.Clear; - AList.Free; - end; + // Free the objects + if AList.Count > 0 then + for i := AList.Count - 1 downto 0 do FreeDataItem(PDataItemSL(AList[i])); + AList.Clear; + AList.Free; end; @@ -2121,26 +2104,24 @@ end; (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) -procedure DummyThreadWorker(SenderThread: TWorkerThread); +procedure TWorkerThread.DummyThreadWorker; var i: integer; begin DebugMsg(['(II) DummyThreadWorker: begin']); - with SenderThread do begin - SetProgress1Params(100); - SetProgress2Params(100); - UpdateProgress1(0, '0 %'); - UpdateProgress2(100, '100 %'); + SetProgress1Params(100); + SetProgress2Params(100); + UpdateProgress1(0, '0 %'); + UpdateProgress2(100, '100 %'); + CommitGUIUpdate; + for i := 1 to 100 do begin + Sleep(100); + DebugMsg([' (II) DummyThreadWorker: done ', i, ' / 100']); + UpdateProgress1(i, Format('%d%%', [i])); + UpdateCaption1(Format('Test %d test', [i])); + UpdateProgress2(101-i, Format('%d%%', [101-i])); + UpdateCaption2(Format('Test %d test', [101-i])); CommitGUIUpdate; - for i := 1 to 100 do begin - Sleep(100); - DebugMsg([' (II) DummyThreadWorker: done ', i, ' / 100']); - UpdateProgress1(i, Format('%d%%', [i])); - UpdateCaption1(Format('Test %d test', [i])); - UpdateProgress2(101-i, Format('%d%%', [101-i])); - UpdateCaption2(Format('Test %d test', [101-i])); - CommitGUIUpdate; - if FCancelled then Break; - end; + if FCancelled then Break; end; DebugMsg(['(II) DummyThreadWorker: finish']); end; -- cgit v1.2.3