Beogradsko programiranje

Monday, February 20, 2017

centos copy

momount /dev/cdrom ---> usually you use /mnt/cdrom (create it (use mkdir)if does not exist)

then cp /mnt/cdrom/

cp -r /home/server/folder/test/* /home/server/

$ cp -avr /tmp/conf/ /tmp/backup

$ cp -avr /mnt/cd/ /var/www/html

-a : Preserve the specified attributes such as directory an file mode, ownership, timestamps, if possible additional attributes: context, links, xattr, all.
-v : Explain what is being done.
-r : Copy directories recursively.

=============================================

mkdir -p /mnt/cdrom
mount /dev/cdrom /mnt/cdrom

=========================================

phpinfo.php in /var/www/html/

=========================================

rm -rf httpd-2.0.48

rm -rf "dir name"

=========================================

+++++++++++++++++++++++++++++

USB...

mount /dev/sdb1 /mnt

umount /mnt

sync

And then remove the USB drive.

++++++++++++++++++++

mkdir -p /media/USB

ls /dev/sd (then hit tab)

You should see something like this:

sda sda1 sda2

Next, insert your USB flash drive into the CentOS 7 machine. Type ls /dev/sd (then hit tab). You should see a new sdb and sdb1.

mount -t vfat /dev/sdb1 /media/USB

cp nfs-utils-1.3.0-0.21.el7_2.x86_64.rpm /media/USB/

umount /media/USB

You can now safely eject the USB flash drive from the CentOS 7 machine.

++++++++++++++++++++++++++

NTFS:

yum install epel-release

yum install ntfs-3g

mkdir /mnt/win

mount -t ntfs-3g /dev/sdb1 /mnt/win

umount /mnt/win

**************************

To mount the NTFS partition permanently, add the following line to the /etc/fstab file.
nano /etc/fstab

And add the line:
/dev/sdb1 /mnt/win ntfs-3g defaults 0 0

Again, replace /dev/sdb1 with the device name that matches your setup. Now your Linux system will mount the NTFS drive automatically at boot time.
***************************

CD...

Mount DVD on CentOS
Mount DVD on CentOS

need to mount CD/DVD on CentOS Temporarily or Permanently? Here’s the Process Us Linux Pro’s Follow:

Login to a terminal window as root

from here to ls /dev

as you can see, there’s alot of stuff here (usually it’s /dvd or /sr0) but how can we be sure?

issue the following two commands to find out what Linux Thinks is the CD/DVD ROM:

ls /dev -l | grep dvd

ls /dev -l | grep cd

Linux seems pretty confident that it’s /dev/sr0 (does windows know how to do that?) Your situation may provide different output, use that.

alright, so at this point, we are talking about the following device: /dev/sr0 (always use the full path)

let’s make a directory to mount it to:

mkdir /mnt/DVD

from here, all we have to do is mount the device

to do a temporary mount (one time only until reboot) issue the following Command:

to do a permanent boot, edit /etc/fstab

Like a good Linux Admin, use the # sign, and put a comment in

from here /dev/sr0 will be mounted to /mnt/DVD the filesystem type and filesystem defaults

Save and quit

issue the almighty Linux Command that Re-Mounts ALL FILESYSTEMS

you should get a notice that it will mount as read-only, that means it mounted, and we can read from it, perfect!

ls /mnt/DVD

as you can see this is an integration services DVD mounted on this CentOS Linux Box.

That’s it!

To Get a Hosted CentOS Linux Server visit www.zwiegnet.comcd/go to get started today!

Tsearch

procedure TForm1.Button1Click(Sender: TObject);
var
Rec: TSearchRec;
FileList: array of string;
DateList: array of TDateTime;
i: Integer;
Done: Boolean;
TempName: string;
TempDate: TDateTime;
begin
// Get files list
if FindFirst('c:\*.*', faAnyFile, Rec) = 0 then
repeat
Setlength(FileList, Length(FileList) + 1);
Setlength(DateList, Length(DateList) + 1);
FileList[High(FileList)]:= Rec.Name;
DateList[High(DateList)]:= FileDateToDateTime(Rec.Time);
until FindNext(Rec) <> 0;
FindClose(Rec);

// Sort
// Bubble sort
repeat
Done:= True;
for i:= 0 to High(FileList) - 1 do
if DateList[i] > DateList[i + 1] then
begin
Done:= False;
TempName:= FileList[i];
FileList[i]:= FileList[i + 1];
FileList[i + 1]:= TempName;

TempDate:= DateList[i];
DateList[i]:= DateList[i + 1];
DateList[i + 1]:= TempDate;

end;

until Done;

// Show in list
ListBox1.Clear;
for i:= 0 to High(FileList) do
ListBox1.Items.Add(FileList[i] + ' ' + DateTimeToStr(DateList[i]));
end;

If you want descending sort then invert the comparison operator to <

if DateList[i] < DateList[i + 1] then

//-------

const
DirectoryPath = 'C:\data\';

procedure TForm1.Button1Click(Sender: TObject);
var
tsr: TSearchRec;
list: TStringList;
x: integer;
begin
list := TStringList.Create;
list.Sorted := true;
try
// Build list of files in time creation order
if FindFirst( DirectoryPath + '*.*', 0, tsr ) = 0 then begin
repeat
list.Append( Format( '%.8x %s', [ tsr.Time, tsr.Name ] ) );
until FindNext( tsr ) <> 0;
FindClose( tsr );
end;
// Process these files one at a time
for x := 0 to list.count - 1 do
Process( DirectoryPath + Copy( list[x], 9, Length(list[x]) ) );
finally
list.free;
end;
end;

procedure TForm1.Process(filename: string);
begin
memo1.Lines.Append( filename );
end;

//----------

http://www.tek-tips.com/viewthread.cfm?qid=1479527

https://www.experts-exchange.com/questions/20533938/Date-sorted-FileList.html

Rotate img

procedure Rotate90(Source: TGraphic; Target: TJpegImage);
var
SourceBmp, TargetBmp: TBitmap;
r, c: Integer;
x, y: Integer;
begin
SourceBmp := TBitmap.Create;
SourceBmp.Assign(Source);
TargetBmp := TBitmap.Create;
TargetBmp.Width := SourceBmp.Height;
TargetBmp.Height := SourceBmp.Width;
for r := 0 to SourceBmp.Height - 1 do
begin
for c := 0 to SourceBmp.Width - 1 do
begin
//x := (SourceBmp.Height-1) - r; // -90
//y := c; //-90
x := r; //90
y := (SourceBmp.Width-1) - c; //90
// look into Bitmap.ScanLine for faster pixel access
TargetBmp.Canvas.Pixels[x, y] := SourceBmp.Canvas.Pixels[c, r];
end;
end;
Target.Assign(TargetBmp);
SourceBmp.Free;
TargetBmp.Free;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Jpeg: TJPEGImage;
begin
Jpeg := TJPEGImage.Create;
Rotate90(Image1.Picture.Graphic, Jpeg);
Image1.Picture.Assign(Jpeg);
Jpeg.Free;
end;

//http://www.efg2.com/Lab/ImageProcessing/FlipReverseRotate.htm
//http://stackoverflow.com/questions/11864236/what-is-the-fastest-way-to-rotate-a-jpg-image-file
//http://www.delphigroups.info/2/12/317243.html
//http://www.efg2.com/Lab/Library/Delphi/Graphics/ImageProcessing.htm

indy ftp server

...unit1.pas...
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StrUtils, IdThreadMgr, IdThreadMgrDefault, IdUserAccounts,
IdBaseComponent, IdComponent, IdTCPServer, IdFTPServer, IdFTPList, StdCtrls,
OleCtrls, SHDocVw, FileCtrl;

type
TForm1 = class(TForm)
IdFTPServer1: TIdFTPServer;
IdUserManager1: TIdUserManager;
FileListBox1: TFileListBox;
IdThreadMgrDefault1: TIdThreadMgrDefault;
WebBrowser1: TWebBrowser;
FileListBox2: TFileListBox;
Memo1: TMemo;
Edit1: TEdit;
Memo2: TMemo;
procedure IdFTPServer1ListDirectory(ASender: TIdFTPServerThread;
const APath: String; ADirectoryListing: TIdFTPListItems);
procedure FormCreate(Sender: TObject);
procedure IdFTPServer1ChangeDirectory(ASender: TIdFTPServerThread;
var VDirectory: String);
procedure FileListBox1Change(Sender: TObject);
procedure IdFTPServer1GetFileSize(ASender: TIdFTPServerThread;
const AFilename: String; var VFileSize: Int64);
procedure IdFTPServer1RetrieveFile(ASender: TIdFTPServerThread;
const AFileName: String; var VStream: TStream);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
private
{ Déclarations privées }
public
{ Déclarations publiques }
end;

var
Form1: TForm1;
implementation

{$R *.dfm}

procedure TForm1.IdFTPServer1ListDirectory(ASender: TIdFTPServerThread;
const APath: String; ADirectoryListing: TIdFTPListItems);
var
buf, FSize : Integer;
FName, FDate : String;
F : file of byte;
begin
Memo1.Clear;
FileListBox1.Directory := APath;
ASender.CurrentDir := '';
ADirectoryListing.ListFormat := flfDos;
for buf := 0 to FileListBox1.Items.Count -1 do
begin
FName := APath + FileListBox1.Items.Strings[Buf];
AssignFile(F, FName);
Reset(F);
FSize := FileSize(F);
CloseFile(F);
FDate := FormatDateTime('mm/dd/yy hh:nn',FileDateToDateTime(FileAge(FName)));
Memo1.Lines.Add(FDate + ' ' + IntToStr(FSize) + ' ' + FileListBox1.Items.Strings[buf]);
end;
Memo2.Clear;
for buf := 0 to FileListBox2.Items.Count -1 do
begin
Edit1.Clear;
Edit1.Text := FileListBox2.Items.Strings[Buf];
Edit1.SelStart := 0;
Edit1.SelLength := 1;
Edit1.ClearSelection;
Edit1.SelStart := Length(Edit1.Text) - 1;
Edit1.SelLength := 1;
Edit1.ClearSelection;
if (Edit1.Text <> '.') and (Edit1.Text <> '..') then
Memo2.Lines.Add(Edit1.Text);
end;
for buf := 0 to Memo2.Lines.Count - 1 do
begin
FDate := '01-01-01 00:00';
Memo1.Lines.Add(FDate + ' <DIR> ' + Memo2.Lines.Strings[buf]);
end;
ADirectoryListing.LoadList(Memo1.Lines);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
WebBrowser1.Navigate('ftp://127.0.0.1');
end;

procedure TForm1.IdFTPServer1ChangeDirectory(ASender: TIdFTPServerThread;
var VDirectory: String);
begin
ASender.CurrentDir := VDirectory;
end;

procedure TForm1.FileListBox1Change(Sender: TObject);
begin
FileListBox2.Directory := FileListBox1.Directory;
end;

procedure TForm1.IdFTPServer1GetFileSize(ASender: TIdFTPServerThread;
const AFilename: String; var VFileSize: Int64);
var
F : File of Byte;
begin
AssignFile(F, AFileName);
Reset(F);
VFileSize := FileSize(F);
CloseFile(F);
end;

procedure TForm1.IdFTPServer1RetrieveFile(ASender: TIdFTPServerThread;
const AFileName: String; var VStream: TStream);
begin
VStream := TFileStream.Create(AFileName,fmOpenRead);
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
idFTPServer1.Threads.Clear;
end;

end.

...Unit1.dfm...
object Form1: TForm1
Left = 211
Top = 107
Width = 640
Height = 433
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCloseQuery = FormCloseQuery
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object FileListBox1: TFileListBox
Left = 0
Top = 8
Width = 169
Height = 153
ItemHeight = 13
TabOrder = 0
OnChange = FileListBox1Change
end
object WebBrowser1: TWebBrowser
Left = 184
Top = 8
Width = 441
Height = 393
TabOrder = 1
ControlData = {
4C000000942D00009E2800000000000000000000000000000000000000000000
000000004C000000000000000000000001000000E0D057007335CF11AE690800
2B2E126208000000000000004C0000000114020000000000C000000000000046
8000000000000000000000000000000000000000000000000000000000000000
00000000000000000100000000000000000000000000000000000000}
end
object FileListBox2: TFileListBox
Left = 0
Top = 176
Width = 169
Height = 65
FileType = [ftDirectory]
ItemHeight = 13
TabOrder = 2
end
object Memo1: TMemo
Left = 0
Top = 248
Width = 169
Height = 129
Lines.Strings = (
'07/02/01 10:01 <DIR> Test'
'05/06/03 1:23 612 test.txt')
ScrollBars = ssBoth
TabOrder = 3
end
object Edit1: TEdit
Left = 0
Top = 384
Width = 121
Height = 21
TabOrder = 4
Text = 'Edit1'
end
object Memo2: TMemo
Left = 0
Top = 292
Width = 185
Height = 69
Lines.Strings = (
'Memo2')
ScrollBars = ssBoth
TabOrder = 5
end
object IdFTPServer1: TIdFTPServer
Active = True
Bindings = <>
CommandHandlers = <>
DefaultPort = 21
Greeting.NumericCode = 220
Greeting.Text.Strings = (
'Serveur FTP Indy prêt.')
Greeting.TextCode = '220'
MaxConnectionReply.NumericCode = 0
ReplyExceptionCode = 0
ReplyTexts = <>
ReplyUnknownCommand.NumericCode = 500
ReplyUnknownCommand.Text.Strings = (
'Erreur de syntaxe, commande non reconnue.')
ReplyUnknownCommand.TextCode = '500'
ThreadMgr = IdThreadMgrDefault1
AnonymousAccounts.Strings = (
'anonymous'
'ftp'
'guest')
HelpReply.Strings = (
'FTP Server by LunaticSkunk')
UserAccounts = IdUserManager1
SystemType = 'WIN32'
OnChangeDirectory = IdFTPServer1ChangeDirectory
OnGetFileSize = IdFTPServer1GetFileSize
OnListDirectory = IdFTPServer1ListDirectory
OnRetrieveFile = IdFTPServer1RetrieveFile
Left = 258
Top = 242
end
object IdUserManager1: TIdUserManager
Accounts = <
item
UserName = 'User'
Password = '1234'
end>
CaseSensitiveUsernames = False
CaseSensitivePasswords = False
Left = 194
Top = 238
end
object IdThreadMgrDefault1: TIdThreadMgrDefault
Left = 222
Top = 240
end
end

Volume set

var
MixerControl: TMixerControl;
MixerControlDetails: TMixerControlDetails;
MixerControlDetailsSigned: TMixerControlDetailsSigned;
Mixer: THandle;
MixerLine: TMixerLine;
MixerLineControls: TMixerLineControls;
PeakMeter: DWord;
Rslt: DWord;
SourceCount: Cardinal;
WaveOut: DWord;
I: Integer;
X: Integer;
Y: Integer;
begin
Rslt := mixerOpen(@Mixer, 0, 0, 0, 0);
if Rslt <> 0 then
raise Exception.CreateFmt('Can''t open mixer (%d)', [Rslt]);
FillChar(MixerLine, SizeOf(MixerLine), 0);
MixerLine.cbStruct := SizeOf(MixerLine);
MixerLine.dwComponentType := MIXERLINE_COMPONENTTYPE_DST_SPEAKERS;
Rslt := mixerGetLineInfo(Mixer, @MixerLine,
MIXER_GETLINEINFOF_COMPONENTTYPE);
if Rslt <> 0 then
raise Exception.CreateFmt('Can''t find speaker line (%d)', [Rslt]);
SourceCount := MixerLine.cConnections;
WaveOut := $FFFFFFFF;
for I := 0 to SourceCount - 1 do
begin
MixerLine.dwSource := I;
Rslt := mixerGetLineInfo(Mixer, @MixerLine,
MIXER_GETLINEINFOF_SOURCE);
if Rslt <> 0 then
raise Exception.CreateFmt('Can''t get source line (%d)', [Rslt]);
if MixerLine.dwComponentType = MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT
then
begin
WaveOut := MixerLine.dwLineId;
Break;
end;
end;
if WaveOut = $FFFFFFFF then
raise Exception.Create('Can''t find wave out device');
FillChar(MixerLineControls, SizeOf(MixerLineControls), 0);
with MixerLineControls do
begin
cbStruct := SizeOf(MixerLineControls);
dwLineId := WaveOut;
dwControlType := MIXERCONTROL_CONTROLTYPE_PEAKMETER;
cControls := 1;
cbmxctrl := SizeOf(TMixerControl);
pamxctrl := @MixerControl;
end;
Rslt := mixerGetLineControls(Mixer, @MixerLineControls,
MIXER_GETLINECONTROLSF_ONEBYTYPE);
if Rslt <> 0 then
raise Exception.CreateFmt('Can''t find peak meter control (%d)',
[Rslt]);
PeakMeter := MixerControl.dwControlID;

// at this point, I have the meter control ID, so I can
// repeatedly query its value and plot the resulting data
// on a canvas

X := 0;
FillChar(MixerControlDetails, SizeOf(MixerControlDetails), 0);
with MixerControlDetails do
begin
cbStruct := SizeOf(MixerControlDetails);
dwControlId := PeakMeter;
cChannels := 1;
cbDetails := SizeOf(MixerControlDetailsSigned);
paDetails := @MixerControlDetailsSigned;
end;
repeat
Sleep(10);
Rslt := mixerGetControlDetails(Mixer, @MixerControlDetails,
MIXER_GETCONTROLDETAILSF_VALUE);
if Rslt <> 0 then
raise Exception.CreateFmt('Can''t get control details (%d)',
[Rslt]);
Application.ProcessMessages;
Inc(X);
Y := 300 - Round(300 * Abs(MixerControlDetailsSigned.lValue) /
32768);
with Canvas do
begin
MoveTo(X, 0);
Pen.Color := clBtnFace;
LineTo(X, 300);
Pen.Color := clWindowText;
LineTo(X, Y);
end;
until X > 500;

// don't forget to close the mixer handle when you're done

Rslt := mixerClose(Mixer);
if Rslt <> 0 then
raise Exception.CreateFmt('Can''t close mixer (%d)', [Rslt]);
end;

http://torry.net/pages.php?id=186

http://www.swissdelphicenter.ch/en/showcode.php?id=225

{1.}

uses
MMSystem;

procedure SetVolume(const volL, volR: Word);
var
hWO: HWAVEOUT;
waveF: TWAVEFORMATEX;
vol: DWORD;
begin
// init TWAVEFORMATEX
FillChar(waveF, SizeOf(waveF), 0);
// open WaveMapper = std output of playsound
waveOutOpen(@hWO, WAVE_MAPPER, @waveF, 0, 0, 0);
vol := volL + volR shl 16;
// set volume
waveOutSetVolume(hWO, vol);
waveOutClose(hWO);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
SetVolume(14000, 14000);
end;

{************************************************}

{2.}

{by Serhiy Perevoznyk}

uses
MMSystem;

function GetVolumeControl(aMixer: HMixer; componentType, ctrlType: Longint;
var mxc: TMixerControl): Boolean;
var
mxl: TMixerLine;
mxlc: TMixerLineControls;
rc: Longint;
begin
Result := False;
FillChar(mxl, SizeOf(TMixerLine), 0);
mxl.cbStruct := SizeOf(TMixerLine);
mxl.dwComponentType := componentType;
{Obtain a line corresponding to the component type}
rc := mixerGetLineInfo(aMixer, @mxl, MIXER_GETLINEINFOF_COMPONENTTYPE);
if rc = MMSYSERR_NOERROR then
begin
with mxlc do
begin
cbStruct := SizeOf(TMixerLineControls);
dwLineID := mxl.dwLineID;
dwControlType := ctrlType;
cControls := 1;
cbmxctrl := SizeOf(TMixerLine);
pamxctrl := @mxc;
pamxctrl^.cbStruct := SizeOf(TMixerControl);
end;
mixerGetLineControls(aMixer, @mxlc, MIXER_GETLINECONTROLSF_ONEBYTYPE);
rc := mixerGetLineControls(aMixer, @mxlc, MIXER_GETLINECONTROLSF_ONEBYTYPE);
Result := rc = MMSYSERR_NOERROR;
end;
end;

function SetVolumeControl(aMixer: HMixer; mxc: TMixerControl; volume: Longint): Boolean;
var
mxcd: TMixerControlDetails;
vol: TMixerControlDetails_Unsigned;
rc: MMRESULT;
begin
FillChar(mxcd, SizeOf(mxcd), 0);
with mxcd do
begin
cbStruct := SizeOf(TMixerControlDetails);
dwControlID := mxc.dwControlID;
cbDetails := SizeOf(TMixerControlDetails_Unsigned);
paDetails := @vol;
cMultipleItems := 0;
cChannels := 1;
end;
vol.dwValue := volume;
rc := mixerSetControlDetails(aMixer, @mxcd, MIXER_SETCONTROLDETAILSF_VALUE);
Result := rc = MMSYSERR_NOERROR;
end;

function InitMixer: HMixer;
var
Err: MMRESULT;
begin
Err := mixerOpen(@Result, 0, 0, 0, 0);
if Err <> MMSYSERR_NOERROR then
Result := 0;
end;

// Example:

procedure SetMasterVolumeToZero;
var
MyMixerHandle: HMixer;
MyVolCtrl: TMixerControl;
begin
MyMixerHandle := InitMixer;
if MyMixerHandle <> 0 then
try
FillChar(MyVolCtrl, SizeOf(MyVolCtrl), 0);
if GetVolumeControl(MyMixerHandle, MIXERLINE_COMPONENTTYPE_DST_SPEAKERS,
MIXERCONTROL_CONTROLTYPE_VOLUME, MyVolCtrl) then
begin
{The last parameter (0) here is the volume level}
if SetVolumeControl(MyMixerHandle, MyVolCtrl, 0) then
ShowMessage('Volume should now be set to zero');
end;
finally
mixerClose(MyMixerHandle);
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
SetMasterVolumeToZero
end;

hta links

http://analystcave.com/vbs-hta-example-for-vba-developers/

http://www.robvanderwoude.com/htaexamples.php

https://www.techwalla.com/articles/how-to-run-an-hta-file-from-vbscript

http://www.htasoft.com/progressbar_hta.htm

pretraga fajlova

List.Items.Add(s+SearchRec.Name+IntToStr(PosInFile(ja,s+SearchRec.Name))); { Adding to list }
http://atviewer.sourceforge.net/atstreamsearch.htm
http://www.yunqa.de/delphi/products/tntunicodecontrols/index
https://community.embarcadero.com/images/38980/Delphi_and_Unicode.pdf
https://www.embarcadero.com/images/old/dm/technical-papers/delphi-in-a-unicode-world-updated.pdf
-------------------------

procedure TForm1.AddAllFilesInDir(const Dir: string);
var
SR: TSearchRec;
begin
if FindFirst(IncludeTrailingBackslash(Dir) + '*.*', faAnyFile or faDirectory, SR) = 0 then
try
repeat
if (SR.Attr and faDirectory) = 0 then
ListBox1.Items.Add(SR.Name)
else if (SR.Name <> '.') and (SR.Name <> '..') then
AddAllFilesInDir(IncludeTrailingBackslash(Dir) + SR.Name); // recursive call!
until FindNext(Sr) <> 0;
finally
FindClose(SR);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ListBox1.Items.BeginUpdate;
AddAllFilesInDir('C:\Users\Andreas Rejbrand\Documents\Aweb');
ListBox1.Items.EndUpdate;
end;

------------------------

procedure FindDocs(const Root: string);
var
SearchRec: TSearchRec;
Folders: array of string;
Folder: string;
I: Integer;
Last: Integer;
begin
SetLength(Folders, 1);
Folders[0] := Root;
I := 0;
while (I < Length(Folders)) do
begin
Folder := IncludeTrailingBackslash(Folders[I]);
Inc(I);
{ Collect child folders first. }
if (FindFirst(Folder + '*.*', faDirectory, SearchRec) = 0) then
begin
repeat
if not ((SearchRec.Name = '.') or (SearchRec.Name = '..')) then
begin
Last := Length(Folders);
SetLength(Folders, Succ(Last));
Folders[Last] := Folder + SearchRec.Name;
end;
until (FindNext(SearchRec) <> 0);
FindClose(SearchRec);
end;
{ Collect files next.}
if (FindFirst(Folder + '*.doc', faAnyFile - faDirectory, SearchRec) = 0) then
begin
repeat
if not ((SearchRec.Attr and faDirectory) = faDirectory) then
begin
WriteLn(Folder, SearchRec.Name);
end;
until (FindNext(SearchRec) <> 0);
FindClose(SearchRec);
end;
end;
end;

----------------------------

procedure TForm1.Button1Click(Sender: TObject);
begin
GetAllSubFolders(Edit1.Text);
end;

procedure TForm1.GetAllSubFolders(sPath: String);
var
Path : String;
Rec : TSearchRec;
begin
try
Path := IncludeTrailingBackslash(sPath);
if FindFirst(Path + '*.*', faDirectory, Rec) = 0 then
try
repeat
if (Rec.Name<>'.') and (Rec.Name<>'..') then
begin
ListBox1.Items.Add(Path+Rec.Name);
GetAllSubFolders(Path + Rec.Name);
end;
until FindNext(Rec) <> 0;
finally
FindClose(Rec);
end;
except
on e: Exception do
Showmessage('Err : TForm1.GetAllSubFolders - '+e.Message);
end;
end;

-----------------------

procedure GetSubDirs(const sRootDir: string; slt: TStrings);
var
srSearch: TSearchRec;
sSearchPath: string;
sltSub: TStrings;
i: Integer;
begin
sltSub := TStringList.Create;
slt.BeginUpdate;
try
sSearchPath := AddDirSeparator(sRootDir);
if FindFirst(sSearchPath + '*', faDirectory, srSearch) = 0 then
repeat
if ((srSearch.Attr and faDirectory) = faDirectory) and
(srSearch.Name <> '.') and
(srSearch.Name <> '..') then
begin
slt.Add(sSearchPath + srSearch.Name);
sltSub.Add(sSearchPath + srSearch.Name);
end;
until (FindNext(srSearch) <> 0);

FindClose(srSearch);

for i := 0 to sltSub.Count - 1 do
GetSubDirs(sltSub.Strings[i], slt);
finally
slt.EndUpdate;
FreeAndNil(sltSub);
end;
end;

------------------------------

procedure TForm1.ListDir(Path:String; List:TListBox);
{Path : string that contains start path for listing filenames and directories
List : List box in which found filenames are going to be stored }
var
SearchRec:TsearchRec;
Result:integer;
S:string; { Used to hold current directory, GetDir(0,s) }
begin
try {Exception handler }
ChDir(Path);
except on EInOutError do
begin
MessageDlg('Error occurred by trying to change directory',mtWarning,[mbOK],0);
Exit;
end;
end;
if length(path)<> 3 then path:=path+'\'; { Checking if path is root, if not add }
FindFirst(path+'*.*',faAnyFile,SearchRec); { '\' at the end of the string }
{ and then add '*.*' for all file }
Repeat
if SearchRec.Attr=faDirectory then { if directory then }
begin
if (SearchRec.Name<>'.') and (SearchRec.Name<>'..') then { Ignore '.' and '..' }
begin
GetDir(0,s); { Get current dir of default drive }
if length(s)<>3 then s:=s+'\'; { Checking if root }
List.Items.Add(s+SearchRec.Name); { Adding to list }
ListDir(s+SearchRec.Name,List); { ListDir found directory }
end;
end
else { if not directory }
begin
GetDir(0,s); { Get current dir of default drive }
if length(s)<>3 then List.items.add(s+'\'+SearchRec.Name) { Checking if root }
else List.items.add(s+SearchRec.Name); { Adding to list }
end;
Result:=FindNext(SearchRec);
Application.ProcessMessages;
until result<>0; { Found all files, go out }
GetDir(0,s);
if length(s)<>3 then ChDir('..'); { if not root then go back one level }
end;

---------------------------

procedure GetFiles(APath: string; AExt: string; AList: TStrings; ARecurse:
boolean);
var
theExt: string;
searchRec: SysUtils.TSearchRec;
begin
if APath[Length(APath)] <> '\' then
APath := APath + '\';
AList.AddObject(APath, Pointer(-1));
if FindFirst(APath + '*.*', faAnyFile, searchRec) = 0 then try
repeat
with searchRec do begin
if (Name <> '.') and (Name <> '..') then
if (Attr and faDirectory <= 0) then begin
theExt := '*' + UpperCase(ExtractFileExt(searchRec.Name));
if (AExt = '*.*') or (theExt = UpperCase(AExt)) then
AList.AddObject(searchRec.Name, Pointer(0))
end
else begin
if ARecurse then begin
GetFiles(APath + Name + '\', AExt, AList, ARecurse);
end;
end;
end; {with searchRec...}
Application.ProcessMessages;
until FindNext(searchRec) <> 0;
finally
SysUtils.FindClose(searchRec);
end;
end;

----------------------------------

function PosInFile(Str,FileName:string):integer;
var
Buffer : array [0..1023] of char;
BufPtr,BufEnd:integer;
F:File;
Index : integer;
Increment : integer;
c : char;

function NextChar : char;
begin
if BufPtr>=BufEnd then
begin
BlockRead(F,Buffer,1024,BufEnd);
BufPtr := 0;
Form1.ProgressBar1.Position := FilePos(F);
Application.ProcessMessages;
end;
Result := Buffer[BufPtr];
Inc(BufPtr);
end;

begin
Result := -1;
AssignFile(F,FileName);
Reset(F,1);
Form1.ProgressBar1.Max := FileSize(F);
BufPtr:=0;
BufEnd:=0;
Index := 0;
Increment := 1;
repeat
c:=NextChar;
if c=Str[Increment] then
Inc(Increment)
else
begin
Inc(Index,Increment);
Increment := 1;
end;
if Increment=(Length(Str)+1) then
begin
Result := Index;
break;
end;
until BufEnd = 0;
CloseFile(F);
Form1.ProgressBar1.Position := 0;
end;

-------------------------

function ScanFile( const filename: String; const forString: String;
caseSensitive: Boolean ): LongInt;
{ returns position of string in file or -1, if not found }
const
BufferSize= $8001; { 32K + 1 bytes }
var
pBuf, pEnd, pScan, pPos: Pchar;
filesize: LongInt;
bytesRemaining: LongInt;
bytesToRead: Word;
F: File;
SearchFor: Pchar;
oldMode: Word;
begin
Result := - 1; { assume failure }
if (Length( forString ) = 0) or (Length( filename ) = 0) then
Exit;
SearchFor := Nil;
pBuf := Nil;
{ open file as binary, 1 byte recordsize }
AssignFile( F, filename );
oldMode := FileMode;
FileMode := 0; { read-only access }
Reset( F, 1 );
FileMode := oldMode;
try { allocate memory for buffer and pchar search string }
SearchFor := StrAlloc( Length( forString ) +1 );
StrPCopy( SearchFor, forString );
if not caseSensitive then { convert to upper case }
AnsiUpper( SearchFor );
GetMem( pBuf, BufferSize );
filesize := System.Filesize( F );
bytesRemaining := filesize;
pPos := Nil;
while bytesRemaining > 0 do
begin
{ calc how many bytes to read this round }
if bytesRemaining >= BufferSize then
bytesToRead := Pred( BufferSize )
else
bytesToRead := bytesRemaining;
{ read a buffer full and zero-terminate the buffer }
BlockRead( F, pBuf^, bytesToRead, bytesToRead );
pEnd := @pBuf[ bytesToRead ];
pEnd^ := #0;
{ scan the buffer. Problem: buffer may contain #0 chars! So we
treat it as a concatenation of zero-terminated strings. }
pScan := pBuf;
while pScan < pEnd do
begin
if not caseSensitive then { convert to upper case }
AnsiUpper( pScan );
pPos := StrPos( pScan, SearchFor ); { search for substring }
if pPos <> Nil then
begin { Found it! }
Result := FileSize - bytesRemaining + LongInt( pPos )
- LongInt( pBuf );
Break;
end;
pScan := StrEnd( pScan );
Inc( pScan );
end;
if pPos <> Nil then
Break;
bytesRemaining := bytesRemaining - bytesToRead;
if bytesRemaining > 0 then
begin
{ no luck in this buffers load. We need to handle the case of
the search string spanning two chunks of file now. We simply
go back a bit in the file and read from there, thus inspecting
some characters twice }
Seek( F, FilePos(F) - Length( forString ));
bytesRemaining := bytesRemaining + Length( forString );
end;
end;
finally
CloseFile( F );
if SearchFor <> Nil then
StrDispose( SearchFor );
if pBuf <> Nil then
FreeMem( pBuf, BufferSize );
end;
end;

-------------------------

procedure TForm1.Button1Click(Sender: TObject);
var
FromF, ToF: file;
NumRead, NumWritten: Integer;
Buf: array[1..2048] of Char;
begin
if OpenDialog1.Execute then { Display Open dialog box. }
begin
AssignFile(FromF, OpenDialog1.FileName);
Reset(FromF, 1); { Record size = 1 }
if SaveDialog1.Execute then { Display Save dialog box. }
begin
AssignFile(ToF, SaveDialog1.FileName); { Open output file. }
Rewrite(ToF, 1); { Record size = 1 }
Canvas.TextOut(10, 10, 'Copying ' + IntToStr(FileSize(FromF))
+ ' bytes...');
repeat
System.BlockRead(FromF, Buf, SizeOf(Buf), NumRead);
BlockWrite(ToF, Buf, NumRead, NumWritten);
until (NumRead = 0) or (NumWritten <> NumRead);
// Use CloseFile rather than Close; Close is provided for backward compatibility.
CloseFile(FromF);
CloseFile(ToF);
Canvas.TextOut(120, 10, ' done.');
end;
end;
end;

-------------------------

//search and replace

Var
TheFile : String;
SearchStringPos : Integer;
YourSearchString : ShortString;
YourReplaceString : ShortString;
begin
RichEdit1.PlainText:=true;
RichEdit1.Lines.LoadFromFile('YourFile.html');
YourSearchString := '<BR>';
YourReplaceString := '<HR>';
TheFile:=RichEdit1.Text;
SearchStringPos:=Pos(YourSearchString,TheFile);
While SearchStringPos > 0 do
begin
RichEdit1.SelStart:=SearchStringPos-1;
RichEdit1.SelLength:=length(YourSearchString);
RichEdit1.SelText:=YourReplaceString;
TheFile:=RichEdit1.Text;
SearchStringPos:=Pos(YourSearchString,TheFile)
end;
RichEdit1.Lines.SaveToFile('YourFile.html');
end;

-------------------------
//SysUtils unit

TS := TStringList.Create;
try
TS.LoadFromFile(filename);
TS.Text := StringReplace(TS.Text, 'foo', 'bar', [rfreplaceAll]);
TS.SaveToFile(filename);
finally
TS.Free;
end;

//TS.Text := StringReplace(TS.Text, '<hr>', '<br>', [rfreplaceAll,rfIgnoreCase]);
-----------------------------