diff --git a/filecopy/filecopy.ico b/filecopy/filecopy.ico new file mode 100644 index 0000000..0341321 Binary files /dev/null and b/filecopy/filecopy.ico differ diff --git a/filecopy/filecopy.lpi b/filecopy/filecopy.lpi new file mode 100644 index 0000000..405d6f1 --- /dev/null +++ b/filecopy/filecopy.lpi @@ -0,0 +1,76 @@ + + + + + + + + + <Scaled Value="True"/> + <ResourceType Value="res"/> + <UseXPManifest Value="True"/> + <XPManifest> + <DpiAware Value="True"/> + </XPManifest> + <Icon Value="0"/> + </General> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + <UseFileFilters Value="True"/> + </PublishOptions> + <RunParams> + <FormatVersion Value="2"/> + <Modes Count="0"/> + </RunParams> + <RequiredPackages Count="1"> + <Item1> + <PackageName Value="LCL"/> + </Item1> + </RequiredPackages> + <Units Count="2"> + <Unit0> + <Filename Value="filecopy.lpr"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="maincopy.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="Form1"/> + <ResourceBaseClass Value="Form"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <Target> + <Filename Value="filecopy"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Linking> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/filecopy/filecopy.lpr b/filecopy/filecopy.lpr new file mode 100644 index 0000000..af23901 --- /dev/null +++ b/filecopy/filecopy.lpr @@ -0,0 +1,22 @@ +program filecopy; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Interfaces, // this includes the LCL widgetset + Forms, maincopy + { you can add units after this }; + +{$R *.res} + +begin + RequireDerivedFormResource:=True; + Application.Scaled:=True; + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. + diff --git a/filecopy/maincopy.lfm b/filecopy/maincopy.lfm new file mode 100644 index 0000000..a56bc51 --- /dev/null +++ b/filecopy/maincopy.lfm @@ -0,0 +1,57 @@ +object Form1: TForm1 + Left = 353 + Height = 240 + Top = 214 + Width = 680 + ClientHeight = 240 + ClientWidth = 680 + LCLVersion = '2.0.0.4' + object lblCopyFrom: TLabel + Left = 20 + Height = 19 + Top = 20 + Width = 118 + Caption = 'Copy from file:' + ParentColor = False + end + object edtCopyFrom: TFileNameEdit + Left = 20 + Height = 31 + Top = 48 + Width = 515 + FileName = 'edtCopyFrom' + OnAcceptFileName = edtCopyFromAcceptFileName + FilterIndex = 0 + HideDirectories = False + ButtonWidth = 23 + NumGlyphs = 1 + MaxLength = 0 + TabOrder = 0 + Text = 'edtCopyFrom' + end + object lblCopyToFile: TLabel + Left = 20 + Height = 19 + Top = 96 + Width = 164 + Caption = 'File will be copied to:' + ParentColor = False + end + object cbDate: TCheckBox + Left = 20 + Height = 21 + Top = 128 + Width = 270 + Caption = 'Copy original file''s date stamp.' + TabOrder = 1 + end + object btnCopy: TButton + Left = 20 + Height = 25 + Top = 176 + Width = 75 + Caption = 'Copy file' + OnClick = btnCopyClick + TabOrder = 2 + end +end diff --git a/filecopy/maincopy.pas b/filecopy/maincopy.pas new file mode 100644 index 0000000..3a89a51 --- /dev/null +++ b/filecopy/maincopy.pas @@ -0,0 +1,120 @@ +unit maincopy; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, EditBtn, + FileUtil, LazUTF8, LazFileUtils; + +type + + { TForm1 } + + TForm1 = class(TForm) + btnCopy: TButton; + cbDate: TCheckBox; + edtCopyFrom: TFileNameEdit; + lblCopyToFile: TLabel; + lblCopyFrom: TLabel; + procedure btnCopyClick(Sender: TObject); + procedure edtCopyFromAcceptFileName(Sender: TObject; var Value: String); + private + SourceFileName: string; + CopiedFileName: string; + procedure CopyFile(sourceName, destinationName: string; copyDateToo: boolean); + end; + +var + Form1: TForm1; + +implementation + +{$R *.lfm} + +{ TForm1 } + +procedure TForm1.btnCopyClick(Sender: TObject); +var append: string; +begin + CopyFile(SourceFileName, CopiedFileName, cbDate.Checked); + btnCopy.Enabled := False; + edtCopyFrom.Text := EmptyStr; + + case cbDate.Checked of + False: append := ' created with current date'; + True: append := ' created with original date'; + end; + + lblCopyToFile.Caption := CopiedFileName + append; +end; + +procedure TForm1.edtCopyFromAcceptFileName(Sender: TObject; var Value: String); +var path, fName: string; +begin + if (Value = EmptyStr) then Exit; + + path := ExtractFilePath(Value); + fName := ExtractFileName(Value); + CopiedFileName := path + 'Copy of ' + fName; + + case FileExistsUTF8(CopiedFileName) of + False: begin + lblCopyToFile.Caption := 'File will be copied to: ' + + CopiedFileName; + + btnCopy.Enabled := True; + SourceFileName := Value; + end; + + True: case QuestionDlg( + 'Warning', CopiedFileName + ' already exists' + sLineBreak + + 'Overwrite existing file?', + mtWarning, + [mrYes, 'Overwrite file', mrNo, 'Cancel file copy'], + 0 + ) of + mrYes: begin + lblCopyToFile.Caption := 'File will be copied to: ' + + CopiedFileName; + + btnCopy.Enabled := True; + SourceFileName := Value; + end; + else begin + Value := EmptyStr; + btnCopy.Enabled := False; + SourceFileName := EmptyStr; + CopiedFileName := EmptyStr; + end; + end; + end; +end; + +procedure TForm1.CopyFile(sourceName, destinationName: string; copyDateToo: boolean); +var + src: TFileStream = nil; + dest: TFileStream = nil; +begin + if SameText(sourceName, destinationName) then Exit; + + src := TFileStream.Create(UTF8ToSys(sourceName), fmOpenRead); + + try + dest := TFileStream.Create(UTF8ToSys(destinationName), fmOpenWrite or fmCreate); + + try + dest.CopyFrom(src, src.Size); + if CopyDateToo + then FileSetDate(dest.Handle, FileGetDate(src.Handle)); + finally + dest.Free; + end; + finally + src.Free; + end; +end; + +end. +