Programlama yapalım ve Öğrenelim.

neoturk: ...Use the shell function to copy-move a file ?...

uses

ShellApi;

procedure ShellFileOperation(fromFile: string; toFile: string; Flags: Integer);

var

shellinfo: TSHFileOpStructA;

begin

with shellinfo do

begin

wnd := Application.Handle;

wFunc := Flags;

pFrom := PChar(fromFile);

pTo := PChar(toFile);

end;

SHFileOperation(shellinfo);

end;

// Example, Beispiel:

procedure TForm1.Button1Click(Sender: TObject);

begin

ShellFileOperation('c:afile.txt', 'd:afile2.txt', FO_COPY);

// To Move a file: FO_MOVE

end;

Delphi - .....................................

neoturk: ...Get-set the date of a folder ?...

function GetFolderDate(Folder: string): TDateTime;

var

Rec: TSearchRec;

Found: Integer;

Date: TDateTime;

begin

if Folder[Length(folder)] = '' then

Delete(Folder, Length(folder), 1);

Result := 0;

Found := FindFirst(Folder, faDirectory, Rec);

try

if Found = 0 then

begin

Date := FileDateToDateTime(Rec.Time);

Result := Date;

end;

finally

FindClose(Rec);

end;

procedure TForm1.Button1Click(Sender: TObject);

var

d: TDateTime;

begin

d := GetFolderDate('C:WINNT');

ShowMessage(FormatDateTime('dddd, d. mmmm yyyy, hh:mm:ss', d));

end;

{ Sets the time for both files and directories }

{ for NT }

function NT_SetDateTime(FileName: string; dtCreation, dtLastAccessTime, dtLastWriteTime: TDateTime): Boolean;

// by Nicholas Robinson

var

hDir: THandle;

ftCreation: TFiletime;

ftLastAccessTime: TFiletime;

ftLastWriteTime: TFiletime;

function DTtoFT(dt: TDateTime): TFiletime;

var

dwft: DWORD;

ft: TFiletime;

begin

dwft := DateTimeToFileDate(dt);

DosDateTimeToFileTime(LongRec(dwft).Hi, LongRec(dwft).Lo, ft);

LocalFileTimeToFileTime(ft, Result);

end;

begin

hDir := CreateFile(PChar(FileName),

GENERIC_READ or GENERIC_WRITE,

nil,

OPEN_EXISTING,

FILE_FLAG_BACKUP_SEMANTICS,

0);

if hDir <> INVALID_HANDLE_VALUE then

begin

try

ftCreation := DTtoFT(dtCreation);

ftLastAccessTime := DTtoFT(dtLastAccessTime);

ftLastWriteTime := DTtoFT(dtLastWriteTime);

Result := SetFileTime(hDir, @ftCreation, @ftLastAccessTime, @ftLastWriteTime);

finally

CloseHandle(hDir);

end;

end

else

Result := False;

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

NT_SetDateTime('c:tempMyFolder', now, now, now);

end;

Delphi - .....................................

neoturk: ...Get-set the date of a folder ?...

function GetFolderDate(Folder: string): TDateTime;

var

Rec: TSearchRec;

Found: Integer;

Date: TDateTime;

begin

if Folder[Length(folder)] = '' then

Delete(Folder, Length(folder), 1);

Result := 0;

Found := FindFirst(Folder, faDirectory, Rec);

try

if Found = 0 then

begin

Date := FileDateToDateTime(Rec.Time);

Result := Date;

end;

finally

FindClose(Rec);

end;

procedure TForm1.Button1Click(Sender: TObject);

var

d: TDateTime;

begin

d := GetFolderDate('C:WINNT');

ShowMessage(FormatDateTime('dddd, d. mmmm yyyy, hh:mm:ss', d));

end;

{ Sets the time for both files and directories }

{ for NT }

function NT_SetDateTime(FileName: string; dtCreation, dtLastAccessTime, dtLastWriteTime: TDateTime): Boolean;

// by Nicholas Robinson

var

hDir: THandle;

ftCreation: TFiletime;

ftLastAccessTime: TFiletime;

ftLastWriteTime: TFiletime;

function DTtoFT(dt: TDateTime): TFiletime;

var

dwft: DWORD;

ft: TFiletime;

begin

dwft := DateTimeToFileDate(dt);

DosDateTimeToFileTime(LongRec(dwft).Hi, LongRec(dwft).Lo, ft);

LocalFileTimeToFileTime(ft, Result);

end;

begin

hDir := CreateFile(PChar(FileName),

GENERIC_READ or GENERIC_WRITE,

nil,

OPEN_EXISTING,

FILE_FLAG_BACKUP_SEMANTICS,

0);

if hDir <> INVALID_HANDLE_VALUE then

begin

try

ftCreation := DTtoFT(dtCreation);

ftLastAccessTime := DTtoFT(dtLastAccessTime);

ftLastWriteTime := DTtoFT(dtLastWriteTime);

Result := SetFileTime(hDir, @ftCreation, @ftLastAccessTime, @ftLastWriteTime);

finally

CloseHandle(hDir);

end;

end

else

Result := False;

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

NT_SetDateTime('c:tempMyFolder', now, now, now);

end;

Delphi - .....................................

neoturk: ...Search a file for a specified text ?...

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; { While }

finally

CloseFile(F);

if SearchFor <> nil then StrDispose(SearchFor);

if pBuf <> nil then FreeMem(pBuf, BufferSize);

end;

end; { ScanFile }

Delphi - .....................................

neoturk: ...Search a file for a specified text ?...

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; { While }

finally

CloseFile(F);

if SearchFor <> nil then StrDispose(SearchFor);

if pBuf <> nil then FreeMem(pBuf, BufferSize);

end;

end; { ScanFile }

Delphi - .....................................

neoturk: ...Compress, decompress a stream ?...

uses

ZLib;

{ Compress a stream }

procedure CompressStream(inpStream, outStream: TStream);

var

InpBuf, OutBuf: Pointer;

InpBytes, OutBytes: Integer;

begin

InpBuf := nil;

OutBuf := nil;

try

GetMem(InpBuf, inpStream.Size);

inpStream.Position := 0;

InpBytes := inpStream.Read(InpBuf^, inpStream.Size);

CompressBuf(InpBuf, InpBytes, OutBuf, OutBytes);

outStream.Write(OutBuf^, OutBytes);

finally

if InpBuf <> nil then FreeMem(InpBuf);

if OutBuf <> nil then FreeMem(OutBuf);

end;

{ Decompress a stream }

procedure DecompressStream(inpStream, outStream: TStream);

var

InpBuf, OutBuf: Pointer;

OutBytes, sz: Integer;

begin

InpBuf := nil;

OutBuf := nil;

sz := inpStream.Size - inpStream.Position;

if sz > 0 then

try

GetMem(InpBuf, sz);

inpStream.Read(InpBuf^, sz);

DecompressBuf(InpBuf, sz, 0, OutBuf, OutBytes);

outStream.Write(OutBuf^, OutBytes);

finally

if InpBuf <> nil then FreeMem(InpBuf);

if OutBuf <> nil then FreeMem(OutBuf);

end;

outStream.Position := 0;

end;

{

Example:

Compress the contents of RichEdit1 and

calculate the compression rate.

Then save the stream to a file (ms2.dat)

Beispiel:

Komprimiert den Inhalt von RichEdit1 und

berechnet die Kompressionsrate.

Dann wird der Stream in eine Datei (ms2.dat) gespeichert.

}

procedure TForm1.Button1Click(Sender: TObject);

var

ms1, ms2: TMemoryStream;

begin

ms1 := TMemoryStream.Create;

try

ms2 := TMemoryStream.Create;

try

RichEdit1.Lines.SaveToStream(ms1);

CompressStream(ms1, ms2);

ShowMessage(Format('Stream Compression Rate: %d %%',

[round(100 / ms1.Size * ms2.Size)]));

ms2.SaveToFile('C:ms2.dat');

finally

ms1.Free;

end;

finally

ms2.Free;

end;

{

Loads the stream from a file (ms2.dat)

and decompresses it.

Then loads the Stream to RichEdit1.

Lädt den komprimierten Stream von einer Datei (ms2.dat)

und dekomprimiert ihn.

Dann wird der Stream wieder in RichEdit1 geladen.

}

procedure TForm1.Button2Click(Sender: TObject);

var

ms1, ms2: TMemoryStream;

begin

ms1 := TMemoryStream.Create;

try

ms2 := TMemoryStream.Create;

try

ms1.LoadFromFile('C:ms2.dat');

DecompressStream(ms1, ms2);

RichEdit1.Lines.LoadFromStream(ms2);

finally

ms1.Free;

end;

finally

ms2.Free;

end;

Delphi - .....................................

neoturk: ...Compress, decompress a stream ?...

uses

ZLib;

{ Compress a stream }

procedure CompressStream(inpStream, outStream: TStream);

var

InpBuf, OutBuf: Pointer;

InpBytes, OutBytes: Integer;

begin

InpBuf := nil;

OutBuf := nil;

try

GetMem(InpBuf, inpStream.Size);

inpStream.Position := 0;

InpBytes := inpStream.Read(InpBuf^, inpStream.Size);

CompressBuf(InpBuf, InpBytes, OutBuf, OutBytes);

outStream.Write(OutBuf^, OutBytes);

finally

if InpBuf <> nil then FreeMem(InpBuf);

if OutBuf <> nil then FreeMem(OutBuf);

end;

{ Decompress a stream }

procedure DecompressStream(inpStream, outStream: TStream);

var

InpBuf, OutBuf: Pointer;

OutBytes, sz: Integer;

begin

InpBuf := nil;

OutBuf := nil;

sz := inpStream.Size - inpStream.Position;

if sz > 0 then

try

GetMem(InpBuf, sz);

inpStream.Read(InpBuf^, sz);

DecompressBuf(InpBuf, sz, 0, OutBuf, OutBytes);

outStream.Write(OutBuf^, OutBytes);

finally

if InpBuf <> nil then FreeMem(InpBuf);

if OutBuf <> nil then FreeMem(OutBuf);

end;

outStream.Position := 0;

end;

{

Example:

Compress the contents of RichEdit1 and

calculate the compression rate.

Then save the stream to a file (ms2.dat)

Beispiel:

Komprimiert den Inhalt von RichEdit1 und

berechnet die Kompressionsrate.

Dann wird der Stream in eine Datei (ms2.dat) gespeichert.

}

procedure TForm1.Button1Click(Sender: TObject);

var

ms1, ms2: TMemoryStream;

begin

ms1 := TMemoryStream.Create;

try

ms2 := TMemoryStream.Create;

try

RichEdit1.Lines.SaveToStream(ms1);

CompressStream(ms1, ms2);

ShowMessage(Format('Stream Compression Rate: %d %%',

[round(100 / ms1.Size * ms2.Size)]));

ms2.SaveToFile('C:ms2.dat');

finally

ms1.Free;

end;

finally

ms2.Free;

end;

{

Loads the stream from a file (ms2.dat)

and decompresses it.

Then loads the Stream to RichEdit1.

Lädt den komprimierten Stream von einer Datei (ms2.dat)

und dekomprimiert ihn.

Dann wird der Stream wieder in RichEdit1 geladen.

}

procedure TForm1.Button2Click(Sender: TObject);

var

ms1, ms2: TMemoryStream;

begin

ms1 := TMemoryStream.Create;

try

ms2 := TMemoryStream.Create;

try

ms1.LoadFromFile('C:ms2.dat');

DecompressStream(ms1, ms2);

RichEdit1.Lines.LoadFromStream(ms2);

finally

ms1.Free;

end;

finally

ms2.Free;

end;

Delphi - .....................................

neoturk: ...Add data to a compiled exe-file ?...

function AttachToFile(const AFileName: string; MemoryStream: TMemoryStream): Boolean;

var

aStream: TFileStream;

iSize: Integer;

begin

Result := False;

if not FileExists(AFileName) then

Exit;

try

aStream := TFileStream.Create(AFileName, fmOpenWrite or fmShareDenyWrite);

MemoryStream.Seek(0, soFromBeginning);

// seek to end of File

// ans Ende der Datei Seeken

aStream.Seek(0, soFromEnd);

// copy data from MemoryStream

// Daten vom MemoryStream kopieren

aStream.CopyFrom(MemoryStream, 0);

// save Stream-Size

// die Streamgröße speichern

iSize := MemoryStream.Size + SizeOf(Integer);

aStream.Write(iSize, SizeOf(iSize));

finally

aStream.Free;

end;

Result := True;

end;

function LoadFromFile(const AFileName: string; MemoryStream: TMemoryStream): Boolean;

var

aStream: TFileStream;

iSize: Integer;

begin

Result := False;

if not FileExists(AFileName) then

Exit;

try

aStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite);

// seek to position where Stream-Size is saved

// zur Position seeken wo Streamgröße gespeichert

aStream.Seek(-SizeOf(Integer), soFromEnd);

aStream.Read(iSize, SizeOf(iSize));

if iSize > aStream.Size then

begin

aStream.Free;

Exit;

end;

// seek to position where data is saved

// zur Position seeken an der die Daten abgelegt sind

aStream.Seek(-iSize, soFromEnd);

MemoryStream.SetSize(iSize - SizeOf(Integer));

MemoryStream.CopyFrom(aStream, iSize - SizeOf(iSize));

MemoryStream.Seek(0, soFromBeginning);

finally

aStream.Free;

end;

Result := True;

end;

procedure TForm1.SaveClick(Sender: TObject);

var

aStream: TMemoryStream;

begin

aStream := TMemoryStream.Create;

Memo1.Lines.SaveToStream(aStream);

AttachToFile('Test.exe', aStream);

aStream.Free;

end;

procedure TForm1.LoadClick(Sender: TObject);

var

aStream: TMemoryStream;

begin

aStream := TMemoryStream.Create;

LoadFromFile('Test.exe', aStream);

Memo1.Lines.LoadFromStream(aStream);

aStream.Free;

end;

{

Note:

You can't proof whether additional data is attached or not.

To reach this, you would have to create a checksumm of the

MemoryStream and attach it.

Hinweis:

Es kann nicht überprüft werden ob zusätzliche Daten in der Datei

vorhanden sind. Um das zu erreichen müsste man eine Checksumme des MemoryStreams

erzeugen und ebenfalls anhängen.

}

Delphi - .....................................

neoturk: ...Add data to a compiled exe-file ?...

function AttachToFile(const AFileName: string; MemoryStream: TMemoryStream): Boolean;

var

aStream: TFileStream;

iSize: Integer;

begin

Result := False;

if not FileExists(AFileName) then

Exit;

try

aStream := TFileStream.Create(AFileName, fmOpenWrite or fmShareDenyWrite);

MemoryStream.Seek(0, soFromBeginning);

// seek to end of File

// ans Ende der Datei Seeken

aStream.Seek(0, soFromEnd);

// copy data from MemoryStream

// Daten vom MemoryStream kopieren

aStream.CopyFrom(MemoryStream, 0);

// save Stream-Size

// die Streamgröße speichern

iSize := MemoryStream.Size + SizeOf(Integer);

aStream.Write(iSize, SizeOf(iSize));

finally

aStream.Free;

end;

Result := True;

end;

function LoadFromFile(const AFileName: string; MemoryStream: TMemoryStream): Boolean;

var

aStream: TFileStream;

iSize: Integer;

begin

Result := False;

if not FileExists(AFileName) then

Exit;

try

aStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite);

// seek to position where Stream-Size is saved

// zur Position seeken wo Streamgröße gespeichert

aStream.Seek(-SizeOf(Integer), soFromEnd);

aStream.Read(iSize, SizeOf(iSize));

if iSize > aStream.Size then

begin

aStream.Free;

Exit;

end;

// seek to position where data is saved

// zur Position seeken an der die Daten abgelegt sind

aStream.Seek(-iSize, soFromEnd);

MemoryStream.SetSize(iSize - SizeOf(Integer));

MemoryStream.CopyFrom(aStream, iSize - SizeOf(iSize));

MemoryStream.Seek(0, soFromBeginning);

finally

aStream.Free;

end;

Result := True;

end;

procedure TForm1.SaveClick(Sender: TObject);

var

aStream: TMemoryStream;

begin

aStream := TMemoryStream.Create;

Memo1.Lines.SaveToStream(aStream);

AttachToFile('Test.exe', aStream);

aStream.Free;

end;

procedure TForm1.LoadClick(Sender: TObject);

var

aStream: TMemoryStream;

begin

aStream := TMemoryStream.Create;

LoadFromFile('Test.exe', aStream);

Memo1.Lines.LoadFromStream(aStream);

aStream.Free;

end;

{

Note:

You can't proof whether additional data is attached or not.

To reach this, you would have to create a checksumm of the

MemoryStream and attach it.

Hinweis:

Es kann nicht überprüft werden ob zusätzliche Daten in der Datei

vorhanden sind. Um das zu erreichen müsste man eine Checksumme des MemoryStreams

erzeugen und ebenfalls anhängen.

}