mirrors/doublecmd
2
0
Fork 0
mirror of https://github.com/doublecmd/doublecmd.git synced 2026-06-21 09:58:13 +00:00
Code Issues Projects Releases Packages Wiki Activity

ADD: Some code for log file implementation

Browse source 
UPD: Replace WriteLn by DebugLn in some places
This commit is contained in:
Alexander Koblov 2008-01-19 22:35:35 +00:00
commit 0bd2510b53
19 changed files with 808 additions and 828 deletions
Download patch file Download diff file Expand all files Collapse all files

2
_make.bat
View file

@ -1,5 +1,5 @@
rem the next line must be changed before run on your computer
set lazpath=X:\Prog\lazarus
set lazpath=X:\Prog\FreePascal\Lazarus
for %%f in (*.lfm) do %lazpath%\Tools\lazres %%~nf.lrs %%f

11
doublecmd.lpr
View file

@ -45,8 +45,8 @@ uses
fEditSearch,
uColorExt,
fEditorConf,
{$IFNDEF MSWINDOWS}
uFindMmap,
{$IFDEF UNIX}
fFileProperties,
uUsersGroups,
{$ENDIF}
@ -66,23 +66,18 @@ const
buildDate = {$I %DATE%};
begin
{$IFDEF MSWINDOWS}
//AssignFile(output, GetHomeDir + 'doublecmd.log');
//Rewrite(output);
{$ENDIF}
Application.Title:='Double Commander';
Application.Initialize;
ThousandSeparator:=' ';
DebugLn('Double commander 0.3 alpha - Free Pascal');
DebugLn('Build: ' + buildDate);
DebugLn('This program is free software released under terms of GNU GPL 2');
DebugLn('(C)opyright 2006-7 Koblov Alexander (Alexx2000@mail.ru)');
DebugLn('(C)opyright 2006-2008 Koblov Alexander (Alexx2000@mail.ru)');
DebugLn(' and contributors (see about dialog)');
fAbout.buildDate := buildDate;
LoadPaths;
LoadPaths; // must be first
if LoadGlobs then
begin
LoadPixMapManager;

8
fconfigtoolbar.pas
View file

@ -132,8 +132,8 @@ begin
ktbBar.FlatButtons := gToolBarFlat;
ktbBar.ChangePath := gpExePath;
ktbBar.EnvVar := '%commander_path%';
ktbBar.LoadFromFile(gpCfgDir + 'default.bar');
stToolBarFileName.Caption := gpCfgDir + 'default.bar';
ktbBar.LoadFromFile(gpIniDir + 'default.bar');
stToolBarFileName.Caption := gpIniDir + 'default.bar';
if ktbBar.Tag >= 0 then
begin
ktbBar.Buttons[ktbBar.Tag].Click;
@ -171,11 +171,11 @@ begin
Save;
gToolBarIconSize := StrToIntDef(kedtBarSize.Text, 16);
gToolBarFlat := cbFlatIcons.Checked;
ktbBar.SaveToFile(gpCfgDir + 'default.bar');
ktbBar.SaveToFile(gpIniDir + 'default.bar');
frmMain.MainToolBar.ButtonGlyphSize := gToolBarIconSize;
frmMain.MainToolBar.DeleteAllToolButtons;
frmMain.MainToolBar.FlatButtons := gToolBarFlat;
frmMain.MainToolBar.LoadFromFile(gpCfgDir + 'default.bar');
frmMain.MainToolBar.LoadFromFile(gpIniDir + 'default.bar');
Close;
end;

2
feditor.pas
View file

@ -169,7 +169,7 @@ begin
editor := TfrmEditor.Create(Application);
gEditorPos.Restore(editor);
try
LoadAttrFromFile(gpCfgDir + csDefaultName);
LoadAttrFromFile(gpIniDir + csDefaultName);
if sFileName='' then
editor.actFileNew.Execute
else

10
feditorconf.pas
View file

@ -271,7 +271,7 @@ begin
lbNames.Items.Add(cSynAttrNames[i]);
lbNames.ItemIndex:=0;
FillComboPred;
LoadAttrFromFile(gpCfgDir + csDefaultName);
LoadAttrFromFile(gpIniDir + csDefaultName);
lbNamesClick(Sender);
end;
@ -320,7 +320,7 @@ var
iIndex:Integer;
begin
cmbPredefined.Clear;
if FindFirst(gpCfgDir+'*.col', faAnyFile, fr)<>0 then
if FindFirst(gpIniDir+'*.col', faAnyFile, fr)<>0 then
begin
FindClose(fr);
Exit;
@ -340,15 +340,15 @@ end;
procedure TfrmEditorConf.btnOKClick(Sender: TObject);
begin
SaveAttrToFile(gpCfgDir + csDefaultName);
SaveAttrToFile(gpIniDir + csDefaultName);
Close;
end;
procedure TfrmEditorConf.cmbPredefinedChange(Sender: TObject);
begin
LoadAttrFromFile(gpCfgDir+cmbPredefined.Text);
LoadAttrFromFile(gpIniDir+cmbPredefined.Text);
lbNamesClick(Self);
// MsgOk(Format(lngGetString(clngEditCfgLoadOK),[gpCfgDir+cmbPredefined.Text]));
// MsgOk(Format(lngGetString(clngEditCfgLoadOK),[gpIniDir+cmbPredefined.Text]));
end;
procedure TfrmEditorConf.btnCancelClick(Sender: TObject);

672
ffileproperties.pas
View file

@ -1,336 +1,336 @@
{
Double Commander
-------------------------------------------------------------------
File Properties Dialog
Copyright (C) 2003-2004 Radek Cervinka (radek.cervinka@centrum.cz)
Copyright (C) 2003 Martin Matusu <xmat@volny.cz>
Copyright (C) 2006-2007 Alexander Koblov (Alexx2000@mail.ru)
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License as
published by the Free Software Foundation; either version 2 of the
License, or (at your option) any later version.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
in a file called COPYING along with this program; if not, write to
the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
02139, USA.
}
unit fFileProperties;
{$mode objfpc}{$H+}
interface
uses
LResources,
SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, uFileList, Buttons, ComCtrls;
type
{ TfrmFileProperties }
TfrmFileProperties = class(TForm)
btnAll: TBitBtn;
btnClose: TButton;
btnOK: TBitBtn;
btnSkip: TBitBtn;
cbExecGroup: TCheckBox;
cbExecOther: TCheckBox;
cbExecOwner: TCheckBox;
cbReadGroup: TCheckBox;
cbReadOther: TCheckBox;
cbReadOwner: TCheckBox;
cbSgid: TCheckBox;
cbSticky: TCheckBox;
cbSuid: TCheckBox;
cbWriteGroup: TCheckBox;
cbWriteOther: TCheckBox;
cbWriteOwner: TCheckBox;
cbxGroups: TComboBox;
cbxUsers: TComboBox;
gbOwner: TGroupBox;
lblAttrBitsStr: TLabel;
lblAttrText: TLabel;
lblExec: TLabel;
lblFile: TLabel;
lblFileName: TLabel;
lblFileName1: TLabel;
lblFileNameStr: TLabel;
lblFolder: TLabel;
lblFolderStr: TLabel;
lblAttrGroupStr: TLabel;
lblGroupStr: TLabel;
lblLastAccess: TLabel;
lblLastAccessStr: TLabel;
lblLastModif: TLabel;
lblLastModifStr: TLabel;
lblLastStChange: TLabel;
lblLastStChangeStr: TLabel;
lblAttrOtherStr: TLabel;
lblAttrOwnerStr: TLabel;
lblOwnerStr: TLabel;
lblRead: TLabel;
lblSize: TLabel;
lblSizeStr: TLabel;
lblSymlink: TLabel;
lblSymlinkStr: TLabel;
lblAttrTextStr: TLabel;
lblType: TLabel;
lblTypeStr: TLabel;
lblWrite: TLabel;
pcPageControl: TPageControl;
tsProperties: TTabSheet;
tsAttributes: TTabSheet;
procedure btnAllClick(Sender: TObject);
procedure btnCloseClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btnOKClick(Sender: TObject);
procedure btnSkipClick(Sender: TObject);
private
bPerm: Boolean;
iCurrent:Integer;
fFileList:TFileList;
procedure ShowAttr(iMode:Integer);
procedure ChangeMod;
procedure ChangeOwner;
function GetModeFromForm:Integer;
public
szPath:String;
procedure ShowFile(iIndex:Integer);
procedure StoreData(FileList:TFileList);
function FindNextSelected:Boolean;
end;
procedure ShowFileProperties(FileList:TFileList; const aPath:String);
implementation
uses
uLng, uFileOp, uFileProcs, uFindEx, BaseUnix, Libc, uUsersGroups;
procedure ShowFileProperties(FileList:TFileList; const aPath:String);
begin
with TfrmFileProperties.Create(Application) do
try
szPath:=aPath;
StoreData(FileList);
if FindNextSelected then
begin
ShowFile(iCurrent);
ShowModal;
end;
finally
Free;
end;
end;
function TfrmFileProperties.GetModeFromForm:Integer;
begin
Result:=0;
if cbReadOwner.Checked then Result:=(Result OR S_IRUSR);
if cbWriteOwner.Checked then Result:=(Result OR S_IWUSR);
if cbExecOwner.Checked then Result:=(Result OR S_IXUSR);
if cbReadGroup.Checked then Result:=(Result OR S_IRGRP);
if cbWriteGroup.Checked then Result:=(Result OR S_IWGRP);
if cbExecGroup.Checked then Result:=(Result OR S_IXGRP);
if cbReadOther.Checked then Result:=(Result OR S_IROTH);
if cbWriteOther.Checked then Result:=(Result OR S_IWOTH);
if cbExecOther.Checked then Result:=(Result OR S_IXOTH);
if cbSuid.Checked then Result:=(Result OR S_ISUID);
if cbSgid.Checked then Result:=(Result OR S_ISGID);
if cbSticky.Checked then Result:=(Result OR S_ISVTX);
end;
procedure TfrmFileProperties.ChangeMod;
begin
fpchmod(PChar(szPath + ffileList.GetItem(iCurrent)^.sName),GetModeFromForm);
end;
procedure TfrmFileProperties.ChangeOwner;
begin
fpchown(PChar(ffileList.GetItem(iCurrent)^.sName),StrToUID(cbxUsers.Text),
StrToGID(cbxGroups.Text));
end;
procedure TfrmFileProperties.btnCloseClick(Sender: TObject);
begin
Close;
end;
procedure TfrmFileProperties.btnAllClick(Sender: TObject);
begin
repeat
ChangeMod;
if(bPerm) then
ChangeOwner;
inc (iCurrent);
until not FindNextSelected;
Close;
end;
procedure TfrmFileProperties.ShowAttr(iMode:Integer);
begin
cbReadOwner.Checked:= ((iMode AND S_IRUSR) = S_IRUSR);
cbWriteOwner.Checked:= ((iMode AND S_IWUSR) = S_IWUSR);
cbExecOwner.Checked:= ((iMode AND S_IXUSR) = S_IXUSR);
cbReadGroup.Checked:= ((iMode AND S_IRGRP) = S_IRGRP);
cbWriteGroup.Checked:= ((iMode AND S_IWGRP) = S_IWGRP);
cbExecGroup.Checked:= ((iMode AND S_IXGRP) = S_IXGRP);
cbReadOther.Checked:= ((iMode AND S_IROTH) = S_IROTH);
cbWriteOther.Checked:= ((iMode AND S_IWOTH) = S_IWOTH);
cbExecOther.Checked:= ((iMode AND S_IXOTH) = S_IXOTH);
cbSuid.Checked:= ((iMode AND S_ISUID) = S_ISUID);
cbSgid.Checked:= ((iMode AND S_ISGID) = S_ISGID);
cbSticky.Checked:= ((iMode AND S_ISVTX) = S_ISVTX);
end;
procedure TfrmFileProperties.ShowFile(iIndex:Integer);
var
sb: uFindEx.Stat64;
dtFileDates:TDateTime;
iMyUID: Cardinal;
begin
try
with fFileList.GetItem(iIndex)^ do
begin
fpstat64(PChar(szPath + sName), sb);
lblFileName.Caption:=sName;
lblFileName1.Caption := sName;
lblFolder.Caption:=szPath;
lblSize.Caption:=IntToStr(iSize);
dtFileDates := FileStampToDateTime(sb.st_atime);
lblLastAccess.Caption:=DateTimeToStr(dtFileDates);
dtFileDates := FileStampToDateTime(sb.st_mtime);
lblLastModif.Caption:=DateTimeToStr(dtFileDates);
dtFileDates := FileStampToDateTime(sb.st_ctime);
lblLastStChange.Caption:=DateTimeToStr(dtFileDates);
if (bIsLink = True) then
lblSymlink.Caption:=Format(rsPropsYes, [sLinkTo])
else
lblSymlink.Caption:=rsPropsNo;
// Chown
begin
iMyUID:=fpGetUID; //get user's UID
bPerm:=(iMyUID=iOwner);
cbxUsers.Text:=sOwner;
if(imyUID=0) then GetUsers(cbxUsers.Items); //huh, a ROOT :))
cbxUsers.Enabled:=(imyUID=0);
cbxGroups.Text:=sGroup;
if(bPerm or (iMyUID=0)) then
GetUsrGroups(iMyUID,cbxGroups.Items);
cbxGroups.Enabled:=(bPerm or (iMyUID=0));
end;
ShowAttr(iMode);
lblAttrText.Caption:=sModeStr; // + 666 like
if FPS_ISDIR(iMode) then
lblType.Caption:=rsPropsFolder
else if FPS_ISREG(iMode) then
lblType.Caption:=rsPropsFile
else if FPS_ISCHR(iMode) then
lblType.Caption:=rsPropsSpChrDev
else if FPS_ISBLK(iMode) then
lblType.Caption:=rsPropsSpBlkDev
else if FPS_ISFIFO(iMode) then
lblType.Caption:=rsPropsNmdPipe
else if FPS_ISLNK(iMode) then
lblType.Caption:=rsPropsSymLink
else if FPS_ISSOCK(iMode) then
lblType.Caption:=rsPropsSocket
else
lblType.Caption:=rsPropsUnknownType;
end;
finally
end;
end;
procedure TfrmFileProperties.StoreData(FileList:TFileList);
var
i, nSelCount:Integer;
begin
fFileList:=FileList;
iCurrent:=0;
nSelCount:=0;
for i:=iCurrent to fFileList.Count-1 do
begin
if fFileList.GetItem(i)^.bSelected then
inc(nSelCount);
end;
end;
function TfrmFileProperties.FindNextSelected:Boolean;
var
i:Integer;
begin
for i:=iCurrent to fFileList.Count-1 do
begin
if fFileList.GetItem(i)^.bSelected then
begin
iCurrent:=i;
Result:=True;
Exit;
end;
end;
Result:=False;
end;
procedure TfrmFileProperties.FormCreate(Sender: TObject);
begin
inherited;
lblFileNameStr.Font.Style:=[fsBold];
lblFileName.Font.Style:=[fsBold];
end;
procedure TfrmFileProperties.btnOKClick(Sender: TObject);
begin
ChangeMod;
if (bPerm) then
ChangeOwner;
btnSkipClick(Self);
end;
procedure TfrmFileProperties.btnSkipClick(Sender: TObject);
begin
inc(iCurrent);
if not FindNextSelected Then
Close
else
ShowFile(iCurrent);
end;
initialization
{$I ffileproperties.lrs}
end.
{
Double Commander
-------------------------------------------------------------------
File Properties Dialog
Copyright (C) 2003-2004 Radek Cervinka (radek.cervinka@centrum.cz)
Copyright (C) 2003 Martin Matusu <xmat@volny.cz>
Copyright (C) 2006-2007 Alexander Koblov (Alexx2000@mail.ru)
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License as
published by the Free Software Foundation; either version 2 of the
License, or (at your option) any later version.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
in a file called COPYING along with this program; if not, write to
the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
02139, USA.
}
unit fFileProperties;
{$mode objfpc}{$H+}
interface
uses
LResources,
SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, uFileList, Buttons, ComCtrls;
type
{ TfrmFileProperties }
TfrmFileProperties = class(TForm)
btnAll: TBitBtn;
btnClose: TButton;
btnOK: TBitBtn;
btnSkip: TBitBtn;
cbExecGroup: TCheckBox;
cbExecOther: TCheckBox;
cbExecOwner: TCheckBox;
cbReadGroup: TCheckBox;
cbReadOther: TCheckBox;
cbReadOwner: TCheckBox;
cbSgid: TCheckBox;
cbSticky: TCheckBox;
cbSuid: TCheckBox;
cbWriteGroup: TCheckBox;
cbWriteOther: TCheckBox;
cbWriteOwner: TCheckBox;
cbxGroups: TComboBox;
cbxUsers: TComboBox;
gbOwner: TGroupBox;
lblAttrBitsStr: TLabel;
lblAttrText: TLabel;
lblExec: TLabel;
lblFile: TLabel;
lblFileName: TLabel;
lblFileName1: TLabel;
lblFileNameStr: TLabel;
lblFolder: TLabel;
lblFolderStr: TLabel;
lblAttrGroupStr: TLabel;
lblGroupStr: TLabel;
lblLastAccess: TLabel;
lblLastAccessStr: TLabel;
lblLastModif: TLabel;
lblLastModifStr: TLabel;
lblLastStChange: TLabel;
lblLastStChangeStr: TLabel;
lblAttrOtherStr: TLabel;
lblAttrOwnerStr: TLabel;
lblOwnerStr: TLabel;
lblRead: TLabel;
lblSize: TLabel;
lblSizeStr: TLabel;
lblSymlink: TLabel;
lblSymlinkStr: TLabel;
lblAttrTextStr: TLabel;
lblType: TLabel;
lblTypeStr: TLabel;
lblWrite: TLabel;
pcPageControl: TPageControl;
tsProperties: TTabSheet;
tsAttributes: TTabSheet;
procedure btnAllClick(Sender: TObject);
procedure btnCloseClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btnOKClick(Sender: TObject);
procedure btnSkipClick(Sender: TObject);
private
bPerm: Boolean;
iCurrent:Integer;
fFileList:TFileList;
procedure ShowAttr(iMode:Integer);
procedure ChangeMod;
procedure ChangeOwner;
function GetModeFromForm:Integer;
public
szPath:String;
procedure ShowFile(iIndex:Integer);
procedure StoreData(FileList:TFileList);
function FindNextSelected:Boolean;
end;
procedure ShowFileProperties(FileList:TFileList; const aPath:String);
implementation
uses
uLng, uFileOp, uFileProcs, uFindEx, BaseUnix, Libc, uUsersGroups;
procedure ShowFileProperties(FileList:TFileList; const aPath:String);
begin
with TfrmFileProperties.Create(Application) do
try
szPath:=aPath;
StoreData(FileList);
if FindNextSelected then
begin
ShowFile(iCurrent);
ShowModal;
end;
finally
Free;
end;
end;
function TfrmFileProperties.GetModeFromForm:Integer;
begin
Result:=0;
if cbReadOwner.Checked then Result:=(Result OR S_IRUSR);
if cbWriteOwner.Checked then Result:=(Result OR S_IWUSR);
if cbExecOwner.Checked then Result:=(Result OR S_IXUSR);
if cbReadGroup.Checked then Result:=(Result OR S_IRGRP);
if cbWriteGroup.Checked then Result:=(Result OR S_IWGRP);
if cbExecGroup.Checked then Result:=(Result OR S_IXGRP);
if cbReadOther.Checked then Result:=(Result OR S_IROTH);
if cbWriteOther.Checked then Result:=(Result OR S_IWOTH);
if cbExecOther.Checked then Result:=(Result OR S_IXOTH);
if cbSuid.Checked then Result:=(Result OR S_ISUID);
if cbSgid.Checked then Result:=(Result OR S_ISGID);
if cbSticky.Checked then Result:=(Result OR S_ISVTX);
end;
procedure TfrmFileProperties.ChangeMod;
begin
fpchmod(PChar(szPath + ffileList.GetItem(iCurrent)^.sName),GetModeFromForm);
end;
procedure TfrmFileProperties.ChangeOwner;
begin
fpchown(PChar(ffileList.GetItem(iCurrent)^.sName),StrToUID(cbxUsers.Text),
StrToGID(cbxGroups.Text));
end;
procedure TfrmFileProperties.btnCloseClick(Sender: TObject);
begin
Close;
end;
procedure TfrmFileProperties.btnAllClick(Sender: TObject);
begin
repeat
ChangeMod;
if(bPerm) then
ChangeOwner;
inc (iCurrent);
until not FindNextSelected;
Close;
end;
procedure TfrmFileProperties.ShowAttr(iMode:Integer);
begin
cbReadOwner.Checked:= ((iMode AND S_IRUSR) = S_IRUSR);
cbWriteOwner.Checked:= ((iMode AND S_IWUSR) = S_IWUSR);
cbExecOwner.Checked:= ((iMode AND S_IXUSR) = S_IXUSR);
cbReadGroup.Checked:= ((iMode AND S_IRGRP) = S_IRGRP);
cbWriteGroup.Checked:= ((iMode AND S_IWGRP) = S_IWGRP);
cbExecGroup.Checked:= ((iMode AND S_IXGRP) = S_IXGRP);
cbReadOther.Checked:= ((iMode AND S_IROTH) = S_IROTH);
cbWriteOther.Checked:= ((iMode AND S_IWOTH) = S_IWOTH);
cbExecOther.Checked:= ((iMode AND S_IXOTH) = S_IXOTH);
cbSuid.Checked:= ((iMode AND S_ISUID) = S_ISUID);
cbSgid.Checked:= ((iMode AND S_ISGID) = S_ISGID);
cbSticky.Checked:= ((iMode AND S_ISVTX) = S_ISVTX);
end;
procedure TfrmFileProperties.ShowFile(iIndex:Integer);
var
sb: uFindEx.Stat64;
dtFileDates:TDateTime;
iMyUID: Cardinal;
begin
try
with fFileList.GetItem(iIndex)^ do
begin
fpstat64(PChar(szPath + sName), sb);
lblFileName.Caption:=sName;
lblFileName1.Caption := sName;
lblFolder.Caption:=szPath;
lblSize.Caption:=IntToStr(iSize);
dtFileDates := FileDateToDateTime(sb.st_atime);
lblLastAccess.Caption:=DateTimeToStr(dtFileDates);
dtFileDates := FileDateToDateTime(sb.st_mtime);
lblLastModif.Caption:=DateTimeToStr(dtFileDates);
dtFileDates := FileDateToDateTime(sb.st_ctime);
lblLastStChange.Caption:=DateTimeToStr(dtFileDates);
if (bIsLink = True) then
lblSymlink.Caption:=Format(rsPropsYes, [sLinkTo])
else
lblSymlink.Caption:=rsPropsNo;
// Chown
begin
iMyUID:=fpGetUID; //get user's UID
bPerm:=(iMyUID=iOwner);
cbxUsers.Text:=sOwner;
if(imyUID=0) then GetUsers(cbxUsers.Items); //huh, a ROOT :))
cbxUsers.Enabled:=(imyUID=0);
cbxGroups.Text:=sGroup;
if(bPerm or (iMyUID=0)) then
GetUsrGroups(iMyUID,cbxGroups.Items);
cbxGroups.Enabled:=(bPerm or (iMyUID=0));
end;
ShowAttr(iMode);
lblAttrText.Caption:=sModeStr; // + 666 like
if FPS_ISDIR(iMode) then
lblType.Caption:=rsPropsFolder
else if FPS_ISREG(iMode) then
lblType.Caption:=rsPropsFile
else if FPS_ISCHR(iMode) then
lblType.Caption:=rsPropsSpChrDev
else if FPS_ISBLK(iMode) then
lblType.Caption:=rsPropsSpBlkDev
else if FPS_ISFIFO(iMode) then
lblType.Caption:=rsPropsNmdPipe
else if FPS_ISLNK(iMode) then
lblType.Caption:=rsPropsSymLink
else if FPS_ISSOCK(iMode) then
lblType.Caption:=rsPropsSocket
else
lblType.Caption:=rsPropsUnknownType;
end;
finally
end;
end;
procedure TfrmFileProperties.StoreData(FileList:TFileList);
var
i, nSelCount:Integer;
begin
fFileList:=FileList;
iCurrent:=0;
nSelCount:=0;
for i:=iCurrent to fFileList.Count-1 do
begin
if fFileList.GetItem(i)^.bSelected then
inc(nSelCount);
end;
end;
function TfrmFileProperties.FindNextSelected:Boolean;
var
i:Integer;
begin
for i:=iCurrent to fFileList.Count-1 do
begin
if fFileList.GetItem(i)^.bSelected then
begin
iCurrent:=i;
Result:=True;
Exit;
end;
end;
Result:=False;
end;
procedure TfrmFileProperties.FormCreate(Sender: TObject);
begin
inherited;
lblFileNameStr.Font.Style:=[fsBold];
lblFileName.Font.Style:=[fsBold];
end;
procedure TfrmFileProperties.btnOKClick(Sender: TObject);
begin
ChangeMod;
if (bPerm) then
ChangeOwner;
btnSkipClick(Self);
end;
procedure TfrmFileProperties.btnSkipClick(Sender: TObject);
begin
inc(iCurrent);
if not FindNextSelected Then
Close
else
ShowFile(iCurrent);
end;
initialization
{$I ffileproperties.lrs}
end.

22
fhardlink.pas
View file

@ -29,7 +29,7 @@ implementation
uses
uLng, uShowMsg, uOSUtils;
uLng, uGlobs, uLog, uShowMsg, uOSUtils;
procedure ShowHardLinkForm(const sNew, sDst:String);
begin
@ -53,13 +53,25 @@ begin
sSrc:=edtNew.Text;
sDst:=edtDst.Text;
if CreateHardLink(sSrc, sDst) then
Close
begin
// write log
if (log_cp_mv_ln in gLogOptions) and (log_success in gLogOptions) then
logWrite(Format(rsMsgLogSuccess+rsMsgLogLink,[sSrc+' -> '+sDst]), lmtSuccess);
Close;
end
else
begin
MsgError(rsHardErrCreate);
end;
begin
// write log
if (log_cp_mv_ln in gLogOptions) and (log_errors in gLogOptions) then
logWrite(Format(rsMsgLogError+rsMsgLogLink,[sSrc+' -> '+sDst]), lmtError);
// Standart error modal dialog
MsgError(rsHardErrCreate);
end;
end;
initialization
{$I fhardlink.lrs}
end.

19
fmain.pas
View file

@ -758,10 +758,7 @@ begin
MainToolBar.ButtonGlyphSize := gToolBarIconSize;
MainToolBar.ChangePath := gpExePath;
MainToolBar.EnvVar := '%commander_path%';
if FileExists(gpIniDir + 'default.bar') then
MainToolBar.LoadFromFile(gpIniDir + 'default.bar')
else
MainToolBar.LoadFromFile(gpCfgDir + 'default.bar');
MainToolBar.LoadFromFile(gpIniDir + 'default.bar')
end;
(*Tool Bar*)
@ -897,7 +894,8 @@ begin
sFileName := fr^.sName;
sFilePath := ActiveDir;
sl.Add(GetSplitFileName(sFileName, sFilePath));
logWrite('View.Add: ' + sFilePath + sFileName, lmtInfo);
if (log_info in gLogOptions) then
logWrite('View.Add: ' + sFilePath + sFileName, lmtInfo);
end;
end;
if sl.Count>0 then
@ -1016,7 +1014,7 @@ begin
if (log_dir_op in gLogOptions) and (log_errors in gLogOptions) then
logWrite(Format(rsMsgLogError+rsMsgLogMkDir, [ActiveDir+sPath]), lmtError);
// Standart modal error dialog
// Standart error modal dialog
msgError(Format(rsMsgErrForceDir,[ActiveDir+sPath]))
end
else
@ -1391,8 +1389,8 @@ end;
procedure TfrmMain.AppException(Sender: TObject; E: Exception);
begin
WriteLN(stdErr,'Exception:',E.Message);
WriteLN(stdErr,'Func:',BackTraceStrFunc(get_caller_frame(get_frame)));
WriteLn(stdErr,'Exception:',E.Message);
WriteLn(stdErr,'Func:',BackTraceStrFunc(get_caller_frame(get_frame)));
Dump_Stack(StdErr, get_caller_frame(get_frame));
end;
@ -2729,10 +2727,7 @@ begin
begin
MainToolBar.ChangePath := gpExePath;
MainToolBar.EnvVar := '%commander_path%';
if FileExists(gpIniDir + 'default.bar') then
MainToolBar.LoadFromFile(gpIniDir + 'default.bar')
else
MainToolBar.LoadFromFile(gpCfgDir + 'default.bar');
MainToolBar.LoadFromFile(gpIniDir + 'default.bar');
MainToolBar.Visible := gButtonBar;
end
else

21
fsymlink.pas
View file

@ -27,7 +27,7 @@ procedure ShowSymLinkForm(const sNew, sDst:String);
implementation
uses
uLng, uShowMsg, uOSUtils;
uLng, uGlobs, uLog, uShowMsg, uOSUtils;
procedure ShowSymLinkForm(const sNew, sDst:String);
begin
@ -51,11 +51,22 @@ begin
sSrc:=edtNew.Text;
sDst:=edtDst.Text;
if CreateSymLink(sSrc, sDst) then
Close
begin
// write log
if (log_cp_mv_ln in gLogOptions) and (log_success in gLogOptions) then
logWrite(Format(rsMsgLogSuccess+rsMsgLogSymLink,[sSrc+' -> '+sDst]), lmtSuccess);
Close;
end
else
begin
MsgError(rsSymErrCreate);
end;
begin
// write log
if (log_cp_mv_ln in gLogOptions) and (log_errors in gLogOptions) then
logWrite(Format(rsMsgLogError+rsMsgLogSymLink,[sSrc+' -> '+sDst]), lmtError);
// Standart error modal dialog
MsgError(rsSymErrCreate);
end;
end;
initialization

6
uGlobsPaths.pas
View file

@ -31,9 +31,9 @@ begin
Ini := TIniFile.Create(gpCfgDir + 'doublecmd.ini');
if Ini.ReadInteger('Configuration', 'UseIniInProgramDir', 1) = 1 then // use ini file from program dir
begin
gpIniDir := gpCfgDir;
end
begin
gpIniDir := gpCfgDir;
end
else
begin
OnGetApplicationName := @GetAppName;

12
ucopythread.pas
View file

@ -29,7 +29,7 @@ type
implementation
uses
SysUtils, Classes, uLng, uGlobs, uShowMsg, uFileProcs, uFindEx, uDCUtils, uOSUtils;
SysUtils, Classes, uLng, uGlobs, uLog, uShowMsg, uFileProcs, uFindEx, uDCUtils, uOSUtils;
procedure TCopyThread.MainExecute;
var
@ -136,6 +136,15 @@ begin
end;
end;
Result:=CopyFile(fr^.sName, sDst+fr^.sPath+sDstNew, FAppend);
if Result then
// write log success
if (log_cp_mv_ln in gLogOptions) and (log_success in gLogOptions) then
logWrite(Format(rsMsgLogSuccess+rsMsgLogCopy, [fr^.sName+' -> '+sDst+fr^.sPath+sDstNew]), lmtSuccess)
else
// write log error
if (log_cp_mv_ln in gLogOptions) and (log_errors in gLogOptions) then
logWrite(Format(rsMsgLogError+rsMsgLogCopy, [fr^.sName+' -> '+sDst+fr^.sPath+sDstNew]), lmtError);
end; // files and other stuff
end;
@ -151,7 +160,6 @@ var
begin
Result:=False;
writeln('CopyFile:',sSrc,' ',sDst);
GetMem(Buffer, gCopyBlockSize+1);
dst:=nil; // for safety exception handling
try

1
udcutils.pas
View file

@ -9,7 +9,6 @@
contributors:
Radek Cervinka <radek.cervinka@centrum.cz>
}
unit uDCUtils;

2
ufileop.pas
View file

@ -108,7 +108,7 @@ begin
{/mate}
fr.iMode:=sb.st_mode;
fr.bSysFile := (sr.Name[1] = '.') and (sr.Name <> '..');
fr.fTimeI:= FileStampToDateTime(sb.st_mtime); // EncodeDate (1970, 1, 1) + (sr.Time / 86400.0);
fr.fTimeI:= FileDateToDateTime(sb.st_mtime); // EncodeDate (1970, 1, 1) + (sr.Time / 86400.0);
{$ELSE} // Windows
fr.iSize:= sr.Size;
fr.iMode:= sr.Attr;

36
ufileopthread.pas
View file

@ -1,15 +1,17 @@
{
Seksi Commander
----------------------------
Implementing of Generic File operation thread
(copying, moving ... is inherited from this)
Seksi Commander
----------------------------
Implementing of Generic File operation thread
(copying, moving ... is inherited from this)
Licence : GNU GPL v 2.0
Author : radek.cervinka@centrum.cz
Licence : GNU GPL v 2.0
Author : radek.cervinka@centrum.cz
contributors:
Koblov Alexander (Alexx2000@mail.ru)
contributors:
Copyright (C) 2006-2008 Koblov Alexander (Alexx2000@mail.ru)
}
unit uFileOpThread;
{$mode objfpc}{$H+}
{$DEFINE NOFAKETHREAD}
@ -106,7 +108,7 @@ var
sb: stat64;
begin
if FindFirst(srcPath+'*',faAnyFile,sr)<>0 then
if FindFirstEx(srcPath+'*',faAnyFile,sr)<>0 then
begin
FindClose(sr);
Exit;
@ -118,20 +120,12 @@ begin
fr.sPath:=dstPath;
fr.sNameNoExt:=sr.Name; // we use to save dstname
// writeln(sr.Name);
{$IFDEF WIN32}
fr.iSize:= sr.Size;
fr.iMode:= sr.Attr;
fr.fTimeI:= FileDateToDateTime(sr.Time);//EncodeDate (1970, 1, 1) + (sr.Time / 86400.0);
{$ELSE}
fpstat64(PChar(fr.sName),sb);
fr.iSize:=sb.st_size;
fr.fTimeI:=FileStampToDateTime(sb.st_mtime);
fr.fTimeI:= FileDateToDateTime(sr.Time);
fr.sTime:=''; // not interested
fr.iMode:=sb.st_mode;
// writeln(sb.st_mode);
if FPS_ISDIR(sb.st_mode) then
writeln('ISDIR');
{$ENDIF}
fr.bIsLink:=FPS_ISLNK(fr.iMode);
fr.sLinkTo:='';
@ -151,7 +145,7 @@ begin
inc(FFilesSize, fr.iSize);
inc(FFilesCount);
end;
until FindNext(sr)<>0;
until FindNextEx(sr)<>0;
FindClose(sr);
end;

17
ufilepanel.pas
View file

@ -155,10 +155,7 @@ begin
else
Raise Exception.Create('fix me:UpdatePanel:bad panelmode');
end;
//flblPath.Height := 14;
//WriteLN('Path = ', flblPath.Caption);
// writeln('fPanel.Row:',fPanel.Row);
// writeln('TFilePanel:', fFileList.Count);
bAnyRow:=fPanel.Row>=0;
fRefList.Clear;
for i:=0 to fFileList.Count-1 do
@ -213,7 +210,7 @@ begin
begin
fActiveDir := fVFS.ArcFullName + sPath;
//WriteLN(output, 'UpDir = ' + sPath);
//DebugLn('UpDir = ' + sPath);
if not fVFS.cdUpLevel(frp, fFileList) then
begin
@ -262,12 +259,12 @@ begin
begin
fVFSmoduleList.AddObject(fVFS.ArcFullName + '=' + sPath, fVFS.VFSmodule);
//WriteLN('sPath ==' + sPath);
//DebugLn('sPath ==' + sPath);
VFSFileList := TFileList.Create;
VFSFileList.CurrentDirectory := ActiveDir;
//WriteLN('ActiveDir == ' + ActiveDir);
//DebugLn('ActiveDir == ' + ActiveDir);
sName := ActiveDir + sName;
VFSFileList.AddItem(frp);
@ -276,7 +273,7 @@ begin
begin
if not fVFS.LoadAndOpen(sTempDir + ExtractDirLevel(ActiveDir, sName)) then Exit;
//WriteLN('sTempDir + sName == ' + sTempDir + sName);
//DebugLn('sTempDir + sName == ' + sTempDir + sName);
fVFS.VFSmodule.VFSList(PathDelim, fFileList);
fPanelMode:=pmArchive;
@ -385,7 +382,7 @@ var
sOpenCmd:String;
begin
// main file input point for decision
// writeln(pfri^.sName);
// DebugLn(pfri^.sName);
with pfri^ do
begin
@ -568,7 +565,7 @@ begin
Result:=nil;
if fPanel.Row<1 then
SysUtils.Abort;
// writeln(fPanel.Row, ' ', fRefList.Count);
// DebugLn(fPanel.Row, ' ', fRefList.Count);
if fPanel.Row>fRefList.Count then
SysUtils.Abort;
Result:=fRefList.Items[fPanel.Row-1]; // 1 is fixed header

97
ufileprocs.pas
View file

@ -1,61 +1,55 @@
{
Seksi Commander
----------------------------
Licence : GNU GPL v 2.0
Author : radek.cervinka@centrum.cz
Seksi Commander
----------------------------
Licence : GNU GPL v 2.0
Author : radek.cervinka@centrum.cz
some file rutines (obsolete)
some file rutines (obsolete)
contributors:
contributors:
Mattias Gaertner (from Lazarus code)
Mattias Gaertner (from Lazarus code)
Alexander Koblov (Alexx2000@mail.ru)
Copyright (C) 2007-2008 Koblov Alexander (Alexx2000@mail.ru)
}
{$mode objfpc}{$H+}
unit uFileProcs;
{$mode objfpc}{$H+}
interface
uses
uTypes, ComCtrls;
type
TFileProc= Function (fr:PFileRecItem; const sDst:String; pb:TProgressBar):Boolean;
TFileProc = function (fr:PFileRecItem; const sDst:String; pb:TProgressBar):Boolean;
function ForceDirectory(DirectoryName: string): boolean;
function FileStampToDateTime(TimeStamp:Longint):TDateTime; // not portable
Function CopyFile(const sSrc, sDst:String; bAppend:Boolean):Boolean;
Function MoveFile(const sSrc, sDst:String; pb:TProgressBar; iSrcRights:Integer):Boolean;
Function DelFile(const sSrc:String):Boolean;
Function RenFile(const sSrc, sDst:String):Boolean;
function CopyFile(const sSrc, sDst:String; bAppend:Boolean=False):Boolean;
function MoveFile(const sSrc, sDst:String; pb:TProgressBar; iSrcRights:Integer):Boolean;
function DelFile(const sSrc:String):Boolean;
function RenFile(const sSrc, sDst:String):Boolean;
implementation
uses
SysUtils, uShowMsg, Classes, uLng, uFindEx {$IFNDEF WIN32}, BaseUnix, UnixUtil{$ENDIF};
LCLProc, SysUtils, uGlobs, uShowMsg, Classes, uLng, uFindEx, uOSUtils;
const
cBlockSize=16384; // size of block if copyfile
// if pb is assigned > use, else work without pb :-)
Function CopyFile(const sSrc, sDst:String; bAppend:Boolean):Boolean;
function CopyFile(const sSrc, sDst:String; bAppend:Boolean):Boolean;
var
src, dst:TFileStream;
stat:stat64;
iDstBeg:Integer; // in the append mode we store original size
Buffer: PChar;
{$IFNDEF WIN32}
utb:putimbuf;
{$ENDIF}
begin
Result:=False;
if not FileExists(sSrc) then Exit;
dst:=nil; // for safety exception handling
GetMem(Buffer,cBlockSize+1);
@ -83,23 +77,7 @@ begin
src.ReadBuffer(Buffer^, src.Size+iDstBeg-dst.size);
dst.WriteBuffer(Buffer^, src.Size+iDstBeg-dst.size);
end;
{$IFNDEF WIN32} // *nix
fpstat64(PChar(sSrc),stat);
// file time
new(utb);
utb^.actime:=stat.st_atime; //last access time // maybe now
utb^.modtime:=stat.st_mtime; // last modification time
fputime(PChar(sSrc),utb);
dispose(utb);
// end file
// owner & group
fpChown(PChar(sSrc),stat.st_uid, stat.st_gid);
// mod
fpChmod(PChar(sSrc), stat.st_mode);
{$ENDIF}
Result:=True;
Result := FileCopyAttr(sSrc, sDst, gDropReadOnlyFlag); // chmod, chgrp
finally
if assigned(src) then
FreeAndNil(src);
@ -118,7 +96,7 @@ begin
end;
end;
Function MoveFile(const sSrc, sDst:String; pb:TProgressBar; iSrcRights:Integer):Boolean;
function MoveFile(const sSrc, sDst:String; pb:TProgressBar; iSrcRights:Integer):Boolean;
begin
Result:=False;
if CopyFile(sSrc, sDst,False) then
@ -126,14 +104,14 @@ begin
end;
// only wrapper for SysUtils.DeleteFile (raise Exception)
Function DelFile(const sSrc:String):Boolean;
function DelFile(const sSrc:String):Boolean;
begin
Result:=SysUtils.DeleteFile(sSrc);
if not Result then
msgError(Format(rsMsgNotDelete,[sSrc]));
end;
Function RenFile(const sSrc, sDst:String):Boolean;
function RenFile(const sSrc, sDst:String):Boolean;
begin
Result:=False;
if FileExists(sDst) and not MsgYesNo(rsMsgFileExistsRwrt) then
@ -148,28 +126,24 @@ var
iBeg:Integer;
sDir: string;
begin
writeln('ForceDirectory:',DirectoryName);
DebugLn('ForceDirectory:',DirectoryName);
i:=1;
iBeg:=1;
if DirectoryName[Length(DirectoryName)]<>PathDelim then
DirectoryName:=DirectoryName+PathDelim;
writeln('ForceDirectory:',DirectoryName);
DebugLn('ForceDirectory:',DirectoryName);
while i<=length(DirectoryName) do
begin
if DirectoryName[i]=PathDelim then
begin
sDir:=copy(DirectoryName,1,i-1);
if (sDir='') then
{$IFDEF WIN32}
sDir:='C:\'; // root
{$ELSE}
sDir:='/'; // root
{$ENDIF}
writeln('Dir:'+sDir);
GetDir(0, sDir);
DebugLn('Dir:'+sDir);
if not DirectoryExists(sDir) then
begin
writeln(copy(DirectoryName,1,iBeg-1));
DebugLn(copy(DirectoryName,1,iBeg-1));
chdir(copy(DirectoryName,1,iBeg-1));
Result:=CreateDir(Copy(DirectoryName, iBeg, i-iBeg));
if not Result then exit;
@ -182,17 +156,4 @@ begin
Result:=true;
end;
function FileStampToDateTime(TimeStamp:Longint):TDateTime;
{$IFDEF WIN32}
begin
Result := EncodeDate (1970, 1, 1) + (TimeStamp / 86400.0);
end;
{$ELSE}
Var
Y,M,D,hh,mm,ss : word;
begin
EpochToLocal(TimeStamp,y,m,d,hh,mm,ss);
Result:=EncodeDate(y,m,d)+EncodeTime(hh,mm,ss,0);
end;
{$ENDIF}
end.

629
ufindex.pas
View file

@ -1,315 +1,314 @@
{
File name: FindEx.pas
Date: 2004/05/xx
Author: Radek Cervinka <radek.cervinka@centrum.cz>
very fast file utils for 64 bit access
fpStat64, fplStat64, Find*64
Copyright (C) 2004
Licence: GNU LGPL or later
Warning Libc version is not much tested
contributors:
Alexander Koblov (Alexx2000@mail.ru)
}
unit uFindEx;
{$mode objfpc}{$H+}
interface
{$DEFINE FAKE_FIND}
{$DEFINE USE_STAT64}
{ $DEFINE USE_STAT64LIBC} // libc version
uses
SysUtils {$IFNDEF WIN32},BaseUnix, Unix, Libc{$IFDEF USE_STAT64LIBC}, Libc {$ELSE}, SysCall{$ENDIF}{$ENDIF};
Type
TFindStatus = (fsOK, fsStatFailed, fsBadAttr);
{$IFDEF USE_STAT64}
{$IFDEF USE_STAT64LIBC}
Stat64 = Libc._stat64;
{$ELSE}
// for kernel syscall check structure
{$I stat64.inc}
{$ENDIF}
{$ENDIF}
function FindFirstEx (Const Path : String; Attr : Longint; out Rslt : TSearchRec) : Longint;
function FindNextEx (Var Rslt : TSearchRec) : Longint;
function CheckAttrMask(DefaultAttr : Cardinal; sAttr : String; Attr : Cardinal) : Boolean;
{$IFNDEF WIN32} //*nix systems
{$IFNDEF FAKE_FIND}
function FindStat (Var Rslt : TSearchRec) :TFindStatus;
{$ENDIF}
{$IFDEF USE_STAT64}
function Fpstat64(path:String; var buf:stat64):cint;
function Fplstat64(path:String; var buf:stat64):cint;
{$IFNDEF FAKE_FIND}
function FindStat64 (Var Rslt : TSearchRec) :TFindStatus;
{$ENDIF}
{$ENDIF}
{$ENDIF} //*nix systems
implementation
{$IFNDEF WIN32} //*nix systems
{$IFNDEF FAKE_FIND}
Function GlobToTSearchRec (Var Info : TSearchRec) : Boolean;
Var
p : Pglob;
GlobSearchRec : PGlobSearchRecEx;
begin
GlobSearchRec:=PGlobSearchRecEx(Info.FindHandle);
P:=GlobSearchRec^.GlobHandle;
Result:=P<>Nil;
If Result then
begin
GlobSearchRec^.GlobHandle:=P^.Next;
With Info do
begin
If P^.Name<>Nil then
Name:=strpas(p^.name)
else
Name:='';
GlobSearchRec^.LastName:=Name;
end;
P^.Next:=Nil;
Unix.GlobFree(P);
end;
end;
Function DoFind(Var Rslt : TSearchRec) : Longint;
Var
GlobSearchRec : PGlobSearchRecEx;
begin
Result:=-1;
GlobSearchRec:=PGlobSearchRecEx(Rslt.FindHandle);
If (GlobSearchRec^.GlobHandle<>Nil) then
While (GlobSearchRec^.GlobHandle<>Nil) and not (Result=0) do
If GlobToTSearchRec(Rslt) Then Result:=0;
end;
{$ENDIF}
{$IFNDEF FAKE_FIND}
Function LinuxToWinAttr (FN : Pchar; Const Info : BaseUnix.Stat) : Longint;
begin
Result:=faArchive;
If fpS_ISDIR(Info.st_mode) then
Result:=Result or faDirectory;
If (FN[0]='.') and (not (FN[1] in [#0,'.'])) then
Result:=Result or faHidden;
If (Info.st_Mode and S_IWUSR)=0 Then
Result:=Result or faReadOnly;
If fpS_ISSOCK(Info.st_mode) or fpS_ISBLK(Info.st_mode) or fpS_ISCHR(Info.st_mode) or fpS_ISFIFO(Info.st_mode) Then
Result:=Result or faSysFile;
end;
{$ENDIF}
{$IFNDEF FAKE_FIND}
function FindStat (Var Rslt : TSearchRec) :TFindStatus;
Var
SInfo : BaseUnix.Stat;
GlobSearchRec : PGlobSearchRecEx;
begin
Result:=fsOK;
GlobSearchRec:=PGlobSearchrecEx(Rslt.FindHandle);
if Fpstat(GlobSearchRec^.Path+GlobSearchRec^.LastName,SInfo)<0 then
Result:=fsStatFailed;
If Result = fsOK then
begin
Rslt.Attr:=LinuxToWinAttr(PChar(GlobSearchRec^.LastName),SInfo);
// hmm, attr support is not good
if (Rslt.ExcludeAttr and Rslt.Attr)<>0 then
Result:=fsBadAttr;
If Result = fsOK Then
With Rslt do
begin
Attr:=Rslt.Attr;
Time:=Sinfo.st_mtime;
Size:=Sinfo.st_Size;
end;
end;
end;
{$ENDIF}
{$IFDEF USE_STAT64}
Function LinuxToWinAttr64 (FN : Pchar; Const Info : Stat64) : Longint;
begin
Result:=faArchive;
If fpS_ISDIR(Info.st_mode) then
Result:=Result or faDirectory;
If (FN[0]='.') and (not (FN[1] in [#0,'.'])) then
Result:=Result or faHidden;
If (Info.st_Mode and S_IWUSR)=0 Then
Result:=Result or faReadOnly;
If fpS_ISSOCK(Info.st_mode) or fpS_ISBLK(Info.st_mode) or fpS_ISCHR(Info.st_mode) or fpS_ISFIFO(Info.st_mode) Then
Result:=Result or faSysFile;
end;
{$IFDEF USE_STAT64LIBC}
function Fpstat64(path:String; var buf:stat64):cint;
begin
Result:=Libc.stat64(Pchar(path),buf);
end;
function Fplstat64(path: String; var buf: stat64): cint;
begin
Result:=Libc.lstat64(Pchar(path),buf);
end;
{$ELSE}
function Fpstat64(path:String; var buf:stat64):cint;
begin
Result:=do_syscall(syscall_nr_stat64,TSysParam(PChar(path)),TSysParam(@buf));
end;
function Fplstat64(path: String; var buf: stat64): cint;
begin
Result:=do_syscall(syscall_nr_lstat64,TSysParam(PChar(path)),TSysParam(@buf));
end;
{$ENDIF}
{$IFNDEF FAKE_FIND}
function FindStat64 (Var Rslt : TSearchRec) :TFindStatus;
Var
SInfo : Stat64;
GlobSearchRec : PGlobSearchRecEx;
begin
Result:=fsOK;
GlobSearchRec:=PGlobSearchrecEx(Rslt.FindHandle);
if Fpstat64(GlobSearchRec^.Path+GlobSearchRec^.LastName,SInfo)<0 then
Result:=fsStatFailed;
If Result = fsOK then
begin
Rslt.Attr:=LinuxToWinAttr64(PChar(GlobSearchRec^.LastName),SInfo);
// hmm, attr support is not good
if (Rslt.ExcludeAttr and Rslt.Attr)<>0 then
Result:=fsBadAttr;
If Result = fsOK Then
With Rslt do
begin
Attr:=Rslt.Attr;
Time:=Sinfo.st_mtime;
Size:=Sinfo.st_Size;
end;
end;
end;
{$ENDIF}
{$ENDIF}
{$ENDIF} //*nix systems
function FindFirstEx (Const Path : String; Attr : Longint; out Rslt : TSearchRec) : Longint;
begin
{$IFDEF UNIX}
if (Attr and faSymLink) = faSymLink then
Attr := Attr or not faSymLink;
{$ENDIF}
Result := FindFirst(Path, Attr, Rslt);
{$IFDEF UNIX}
if Result = 0 then
Rslt.Attr := Rslt.Mode;
{$ENDIF}
end;
function FindNextEx (Var Rslt : TSearchRec) : Longint;
begin
Result := FindNext(Rslt);
{$IFDEF UNIX}
if Result = 0 then
Rslt.Attr := Rslt.Mode;
{$ENDIF}
end;
function CheckAttrMask(DefaultAttr : Cardinal; sAttr : String; Attr : Cardinal) : Boolean;
{$IFDEF WINDOWS}
begin
Result := True;
if (DefaultAttr <> 0) and (DefaultAttr <> faAnyFile) then
Result := (Attr and DefaultAttr) = DefaultAttr;
if Length(sAttr) < 4 then Exit;
if Result then
begin
if sAttr[1] = 'r' then Result := Result and ((Attr and faReadOnly) = faReadOnly)
else if sAttr[1] = '-' then Result := Result and ((Attr and faReadOnly) <> faReadOnly);
//WriteLN('After r == ', BoolToStr(Result));
if sAttr[2] = 'a' then Result := Result and ((Attr and faArchive) = faArchive)
else if sAttr[2] = '-' then Result := Result and ((Attr and faArchive) <> faArchive);
//WriteLN('After a == ', BoolToStr(Result));
if sAttr[3] = 'h' then Result := Result and ((Attr and faHidden) = faHidden)
else if sAttr[3] = '-' then Result := Result and ((Attr and faHidden) <> faHidden);
//WriteLN('After h == ', BoolToStr(Result));
if sAttr[4] = 's' then Result := Result and ((Attr and faSysFile) = faSysFile)
else if sAttr[4] = '-' then Result := Result and ((Attr and faSysFile) <> faSysFile);
end;
end;
{$ELSE}
begin
Result := True;
if (DefaultAttr <> 0) and (DefaultAttr <> faAnyFile) then
begin
if Boolean(DefaultAttr and faDirectory) then
Result := Result and fpS_ISDIR(Attr);
WriteLN('Result do == ', BoolToStr(Result));
if Boolean(DefaultAttr and faSymLink) then
Result := Result and ((Attr and S_IFLNK) = S_IFLNK);
WriteLN('Result after == ', BoolToStr(Result));
end;
if Length(sAttr) < 9 then Exit;
if sAttr[1]='r' then Result:=Result and ((Attr AND S_IRUSR) = S_IRUSR)
else if sAttr[1]='-' then Result:=Result and ((Attr AND S_IRUSR) <> S_IRUSR);
if sAttr[2]='w' then Result:=Result and ((Attr AND S_IWUSR) = S_IWUSR)
else if sAttr[2]='-' then Result:=Result and ((Attr AND S_IWUSR) <> S_IWUSR);
if sAttr[3]='x' then Result:=Result and ((Attr AND S_IXUSR) = S_IXUSR)
else if sAttr[3]='-' then Result:=Result and ((Attr AND S_IXUSR) <> S_IXUSR);
if sAttr[4]='r' then Result:=Result and ((Attr AND S_IRGRP) = S_IRGRP)
else if sAttr[4]='-' then Result:=Result and ((Attr AND S_IRGRP) <> S_IRGRP);
if sAttr[5]='w' then Result:=Result and ((Attr AND S_IWGRP) = S_IWGRP)
else if sAttr[5]='-' then Result:=Result and ((Attr AND S_IWGRP) <> S_IWGRP);
if sAttr[6]='x' then Result:=Result and ((Attr AND S_IXGRP) = S_IXGRP)
else if sAttr[6]='-' then Result:=Result and ((Attr AND S_IXGRP) <> S_IXGRP);
if sAttr[7]='r' then Result:=Result and ((Attr AND S_IROTH) = S_IROTH)
else if sAttr[7]='-' then Result:=Result and ((Attr AND S_IROTH) <> S_IROTH);
if sAttr[8]='w' then Result:=Result and ((Attr AND S_IWOTH) = S_IWOTH)
else if sAttr[8]='-' then Result:=Result and ((Attr AND S_IWOTH) <> S_IWOTH);
if sAttr[9]='x' then Result:=Result and ((Attr AND S_IXOTH) = S_IXOTH)
else if sAttr[9]='-' then Result:=Result and ((Attr AND S_IXOTH) <> S_IXOTH);
if sAttr[3]='s' then Result:=Result and ((Attr AND S_ISUID) = S_ISUID);
if sAttr[6]='s' then Result:=Result and ((Attr AND S_ISGID) = S_ISGID);
end;
{$ENDIF}
end.
{
File name: FindEx.pas
Date: 2004/05/xx
Author: Radek Cervinka <radek.cervinka@centrum.cz>
very fast file utils for 64 bit access
fpStat64, fplStat64, Find*64
Copyright (C) 2004
Licence: GNU LGPL or later
Warning Libc version is not much tested
contributors:
Copyright (C) 2006-2008 Koblov Alexander (Alexx2000@mail.ru)
}
unit uFindEx;
{$mode objfpc}{$H+}
interface
{$DEFINE FAKE_FIND}
{$DEFINE USE_STAT64}
{ $DEFINE USE_STAT64LIBC} // libc version
uses
SysUtils {$IFNDEF WIN32},BaseUnix, Unix, Libc{$IFDEF USE_STAT64LIBC}, Libc {$ELSE}, SysCall{$ENDIF}{$ENDIF};
Type
TFindStatus = (fsOK, fsStatFailed, fsBadAttr);
{$IFDEF USE_STAT64}
{$IFDEF USE_STAT64LIBC}
Stat64 = Libc._stat64;
{$ELSE}
// for kernel syscall check structure
{$I stat64.inc}
{$ENDIF}
{$ENDIF}
function FindFirstEx (Const Path : String; Attr : Longint; out Rslt : TSearchRec) : Longint;
function FindNextEx (Var Rslt : TSearchRec) : Longint;
function CheckAttrMask(DefaultAttr : Cardinal; sAttr : String; Attr : Cardinal) : Boolean;
{$IFDEF UNIX} //*nix systems
{$IFNDEF FAKE_FIND}
function FindStat (Var Rslt : TSearchRec) :TFindStatus;
{$ENDIF}
{$IFDEF USE_STAT64}
function Fpstat64(path:String; var buf:stat64):cint;
function Fplstat64(path:String; var buf:stat64):cint;
{$IFNDEF FAKE_FIND}
function FindStat64 (Var Rslt : TSearchRec) :TFindStatus;
{$ENDIF}
{$ENDIF}
{$ENDIF} //*nix systems
implementation
{$IFDEF UNIX} //*nix systems
{$IFNDEF FAKE_FIND}
Function GlobToTSearchRec (Var Info : TSearchRec) : Boolean;
Var
p : Pglob;
GlobSearchRec : PGlobSearchRecEx;
begin
GlobSearchRec:=PGlobSearchRecEx(Info.FindHandle);
P:=GlobSearchRec^.GlobHandle;
Result:=P<>Nil;
If Result then
begin
GlobSearchRec^.GlobHandle:=P^.Next;
With Info do
begin
If P^.Name<>Nil then
Name:=strpas(p^.name)
else
Name:='';
GlobSearchRec^.LastName:=Name;
end;
P^.Next:=Nil;
Unix.GlobFree(P);
end;
end;
Function DoFind(Var Rslt : TSearchRec) : Longint;
Var
GlobSearchRec : PGlobSearchRecEx;
begin
Result:=-1;
GlobSearchRec:=PGlobSearchRecEx(Rslt.FindHandle);
If (GlobSearchRec^.GlobHandle<>Nil) then
While (GlobSearchRec^.GlobHandle<>Nil) and not (Result=0) do
If GlobToTSearchRec(Rslt) Then Result:=0;
end;
{$ENDIF}
{$IFNDEF FAKE_FIND}
Function LinuxToWinAttr (FN : Pchar; Const Info : BaseUnix.Stat) : Longint;
begin
Result:=faArchive;
If fpS_ISDIR(Info.st_mode) then
Result:=Result or faDirectory;
If (FN[0]='.') and (not (FN[1] in [#0,'.'])) then
Result:=Result or faHidden;
If (Info.st_Mode and S_IWUSR)=0 Then
Result:=Result or faReadOnly;
If fpS_ISSOCK(Info.st_mode) or fpS_ISBLK(Info.st_mode) or fpS_ISCHR(Info.st_mode) or fpS_ISFIFO(Info.st_mode) Then
Result:=Result or faSysFile;
end;
{$ENDIF}
{$IFNDEF FAKE_FIND}
function FindStat (Var Rslt : TSearchRec) :TFindStatus;
Var
SInfo : BaseUnix.Stat;
GlobSearchRec : PGlobSearchRecEx;
begin
Result:=fsOK;
GlobSearchRec:=PGlobSearchrecEx(Rslt.FindHandle);
if Fpstat(GlobSearchRec^.Path+GlobSearchRec^.LastName,SInfo)<0 then
Result:=fsStatFailed;
If Result = fsOK then
begin
Rslt.Attr:=LinuxToWinAttr(PChar(GlobSearchRec^.LastName),SInfo);
// hmm, attr support is not good
if (Rslt.ExcludeAttr and Rslt.Attr)<>0 then
Result:=fsBadAttr;
If Result = fsOK Then
With Rslt do
begin
Attr:=Rslt.Attr;
Time:=Sinfo.st_mtime;
Size:=Sinfo.st_Size;
end;
end;
end;
{$ENDIF}
{$IFDEF USE_STAT64}
Function LinuxToWinAttr64 (FN : Pchar; Const Info : Stat64) : Longint;
begin
Result:=faArchive;
If fpS_ISDIR(Info.st_mode) then
Result:=Result or faDirectory;
If (FN[0]='.') and (not (FN[1] in [#0,'.'])) then
Result:=Result or faHidden;
If (Info.st_Mode and S_IWUSR)=0 Then
Result:=Result or faReadOnly;
If fpS_ISSOCK(Info.st_mode) or fpS_ISBLK(Info.st_mode) or fpS_ISCHR(Info.st_mode) or fpS_ISFIFO(Info.st_mode) Then
Result:=Result or faSysFile;
end;
{$IFDEF USE_STAT64LIBC}
function Fpstat64(path:String; var buf:stat64):cint;
begin
Result:=Libc.stat64(Pchar(path),buf);
end;
function Fplstat64(path: String; var buf: stat64): cint;
begin
Result:=Libc.lstat64(Pchar(path),buf);
end;
{$ELSE}
function Fpstat64(path:String; var buf:stat64):cint;
begin
Result:=do_syscall(syscall_nr_stat64,TSysParam(PChar(path)),TSysParam(@buf));
end;
function Fplstat64(path: String; var buf: stat64): cint;
begin
Result:=do_syscall(syscall_nr_lstat64,TSysParam(PChar(path)),TSysParam(@buf));
end;
{$ENDIF}
{$IFNDEF FAKE_FIND}
function FindStat64 (Var Rslt : TSearchRec) :TFindStatus;
Var
SInfo : Stat64;
GlobSearchRec : PGlobSearchRecEx;
begin
Result:=fsOK;
GlobSearchRec:=PGlobSearchrecEx(Rslt.FindHandle);
if Fpstat64(GlobSearchRec^.Path+GlobSearchRec^.LastName,SInfo)<0 then
Result:=fsStatFailed;
If Result = fsOK then
begin
Rslt.Attr:=LinuxToWinAttr64(PChar(GlobSearchRec^.LastName),SInfo);
// hmm, attr support is not good
if (Rslt.ExcludeAttr and Rslt.Attr)<>0 then
Result:=fsBadAttr;
If Result = fsOK Then
With Rslt do
begin
Attr:=Rslt.Attr;
Time:=Sinfo.st_mtime;
Size:=Sinfo.st_Size;
end;
end;
end;
{$ENDIF}
{$ENDIF}
{$ENDIF} //*nix systems
function FindFirstEx (Const Path : String; Attr : Longint; out Rslt : TSearchRec) : Longint;
begin
{$IFDEF UNIX}
if (Attr and faSymLink) = faSymLink then
Attr := Attr or not faSymLink;
{$ENDIF}
Result := FindFirst(Path, Attr, Rslt);
{$IFDEF UNIX}
if Result = 0 then
Rslt.Attr := Rslt.Mode;
{$ENDIF}
end;
function FindNextEx (Var Rslt : TSearchRec) : Longint;
begin
Result := FindNext(Rslt);
{$IFDEF UNIX}
if Result = 0 then
Rslt.Attr := Rslt.Mode;
{$ENDIF}
end;
function CheckAttrMask(DefaultAttr : Cardinal; sAttr : String; Attr : Cardinal) : Boolean;
{$IFDEF WINDOWS}
begin
Result := True;
if (DefaultAttr <> 0) and (DefaultAttr <> faAnyFile) then
Result := (Attr and DefaultAttr) = DefaultAttr;
if Length(sAttr) < 4 then Exit;
if Result then
begin
if sAttr[1] = 'r' then Result := Result and ((Attr and faReadOnly) = faReadOnly)
else if sAttr[1] = '-' then Result := Result and ((Attr and faReadOnly) <> faReadOnly);
//WriteLN('After r == ', BoolToStr(Result));
if sAttr[2] = 'a' then Result := Result and ((Attr and faArchive) = faArchive)
else if sAttr[2] = '-' then Result := Result and ((Attr and faArchive) <> faArchive);
//WriteLN('After a == ', BoolToStr(Result));
if sAttr[3] = 'h' then Result := Result and ((Attr and faHidden) = faHidden)
else if sAttr[3] = '-' then Result := Result and ((Attr and faHidden) <> faHidden);
//WriteLN('After h == ', BoolToStr(Result));
if sAttr[4] = 's' then Result := Result and ((Attr and faSysFile) = faSysFile)
else if sAttr[4] = '-' then Result := Result and ((Attr and faSysFile) <> faSysFile);
end;
end;
{$ELSE}
begin
Result := True;
if (DefaultAttr <> 0) and (DefaultAttr <> faAnyFile) then
begin
if Boolean(DefaultAttr and faDirectory) then
Result := Result and fpS_ISDIR(Attr);
WriteLN('Result do == ', BoolToStr(Result));
if Boolean(DefaultAttr and faSymLink) then
Result := Result and ((Attr and S_IFLNK) = S_IFLNK);
WriteLN('Result after == ', BoolToStr(Result));
end;
if Length(sAttr) < 9 then Exit;
if sAttr[1]='r' then Result:=Result and ((Attr AND S_IRUSR) = S_IRUSR)
else if sAttr[1]='-' then Result:=Result and ((Attr AND S_IRUSR) <> S_IRUSR);
if sAttr[2]='w' then Result:=Result and ((Attr AND S_IWUSR) = S_IWUSR)
else if sAttr[2]='-' then Result:=Result and ((Attr AND S_IWUSR) <> S_IWUSR);
if sAttr[3]='x' then Result:=Result and ((Attr AND S_IXUSR) = S_IXUSR)
else if sAttr[3]='-' then Result:=Result and ((Attr AND S_IXUSR) <> S_IXUSR);
if sAttr[4]='r' then Result:=Result and ((Attr AND S_IRGRP) = S_IRGRP)
else if sAttr[4]='-' then Result:=Result and ((Attr AND S_IRGRP) <> S_IRGRP);
if sAttr[5]='w' then Result:=Result and ((Attr AND S_IWGRP) = S_IWGRP)
else if sAttr[5]='-' then Result:=Result and ((Attr AND S_IWGRP) <> S_IWGRP);
if sAttr[6]='x' then Result:=Result and ((Attr AND S_IXGRP) = S_IXGRP)
else if sAttr[6]='-' then Result:=Result and ((Attr AND S_IXGRP) <> S_IXGRP);
if sAttr[7]='r' then Result:=Result and ((Attr AND S_IROTH) = S_IROTH)
else if sAttr[7]='-' then Result:=Result and ((Attr AND S_IROTH) <> S_IROTH);
if sAttr[8]='w' then Result:=Result and ((Attr AND S_IWOTH) = S_IWOTH)
else if sAttr[8]='-' then Result:=Result and ((Attr AND S_IWOTH) <> S_IWOTH);
if sAttr[9]='x' then Result:=Result and ((Attr AND S_IXOTH) = S_IXOTH)
else if sAttr[9]='-' then Result:=Result and ((Attr AND S_IXOTH) <> S_IXOTH);
if sAttr[3]='s' then Result:=Result and ((Attr AND S_ISUID) = S_ISUID);
if sAttr[6]='s' then Result:=Result and ((Attr AND S_ISGID) = S_ISGID);
end;
{$ENDIF}
end.

67
uglobs.pas
View file

@ -1,17 +1,16 @@
{
Double Commander
------------------------------------------------------------
Seksi Commander
----------------------------
Licence : GNU GPL v 2.0
Author : radek.cervinka@centrum.cz
Double Commander
------------------------------------------------------------
Seksi Commander
----------------------------
Licence : GNU GPL v 2.0
Author : radek.cervinka@centrum.cz
Globals variables and some consts
Globals variables and some consts
contributors:
Copyright (C) 2006-2008 Alexander Koblov (Alexx2000@mail.ru)
contributors:
Copyright (C) 2006-2008 Alexander Koblov (Alexx2000@mail.ru)
}
unit uGlobs;
@ -155,17 +154,17 @@ var
implementation
uses
LCLProc, SysUtils, uGlobsPaths, uLng, uShowMsg, uOSUtils;
LCLProc, SysUtils, uGlobsPaths, uLng, uShowMsg, uFileProcs, uOSUtils;
// for debugging only, can be removed
procedure dbgShowWindowPos(const pos: TControlPosition);
begin
DebugLN('TWindowPos');
DebugLN('Left: ', IntToStr(pos.Left));
DebugLN('Top: ', IntToStr(pos.Top));
DebugLN('Width: ', IntToStr(pos.Width));
DebugLN('Height: ', IntToStr(pos.Height));
DebugLN('END');
DebugLn('TWindowPos');
DebugLn('Left: ', IntToStr(pos.Left));
DebugLn('Top: ', IntToStr(pos.Top));
DebugLn('Width: ', IntToStr(pos.Width));
DebugLn('Height: ', IntToStr(pos.Height));
DebugLn('END');
end;
procedure TControlPosition.Save(Control: TControl);
@ -202,11 +201,27 @@ end;
procedure InitGlobs;
begin
if FileExists(gpIniDir + 'doublecmd.ini') then
gIni := TIniFile.Create(gpIniDir + 'doublecmd.ini')
else
gIni := TIniFile.Create(gpCfgDir + 'doublecmd.ini');
{ Create default configuration files if need }
// main ini file
if not FileExists(gpIniDir + 'doublecmd.ini') then
CopyFile(gpCfgDir + 'doublecmd.ini', gpIniDir + 'doublecmd.ini');
// toolbar file
if not FileExists(gpIniDir + 'default.bar') then
CopyFile(gpCfgDir + 'default.bar', gpIniDir + 'default.bar');
// extension file
if not FileExists(gpIniDir + 'doublecmd.ext') then
CopyFile(gpCfgDir + 'doublecmd.ext', gpIniDir + 'doublecmd.ext');
// pixmaps file
if not FileExists(gpIniDir + 'pixmaps.txt') then
CopyFile(gpCfgDir + 'pixmaps.txt', gpIniDir + 'pixmaps.txt');
// editor highlight file1
if not FileExists(gpIniDir + 'editor.col') then
CopyFile(gpCfgDir + 'editor.col', gpIniDir + 'editor.col');
// editor highlight file2
if not FileExists(gpIniDir + 'twilight.col') then
CopyFile(gpCfgDir + 'twilight.col', gpIniDir + 'twilight.col');
gIni := TIniFile.Create(gpIniDir + 'doublecmd.ini');
gExts := TExts.Create;
gColorExt := TColorExt.Create;
glsHotDir := TStringList.Create;
@ -308,8 +323,8 @@ begin
gCustomDriveIcons := gIni.ReadBool('Configuration', 'CustomDriveIcons', False);
if FileExists(gpCfgDir + 'doublecmd.ext') then
gExts.LoadFromFile(gpCfgDir + 'doublecmd.ext');
if FileExists(gpIniDir + 'doublecmd.ext') then
gExts.LoadFromFile(gpIniDir + 'doublecmd.ext');
if FileExists(gpIniDir + 'dirhistory.txt') then
LoadStringsFromFile(glsDirHistory,gpIniDir + 'dirhistory.txt');
@ -361,12 +376,6 @@ var
begin
glsDirHistory.SaveToFile(gpIniDir + 'dirhistory.txt');
glsMaskHistory.SaveToFile(gpIniDir + 'maskhistory.txt');
if gIni.FileName <> gpIniDir + 'doublecmd.ini' then
begin
gIni.Free;
gIni := TIniFile.Create(gpIniDir + 'doublecmd.ini');
end;
{Layout page}

2
upixmapmanager.pas
View file

@ -669,7 +669,7 @@ procedure LoadPixMapManager;
begin
PixMapManager:=TPixMapManager.Create;
PixMapManager.FPixmapSize:= IntToStr(gIconsSize) + 'x' + IntToStr(gIconsSize) + PathDelim;
PixMapManager.Load(gpExePath+'pixmaps.txt');
PixMapManager.Load(gpIniDir+'pixmaps.txt');
end;
initialization