Programlama yapalım ve Öğrenelim.

neoturk: ...How to search a file for a string ?...

{

ScanFile searches for a string in a file and returns the position of the string

in the file or -1, if not found.

ScanFile sucht in einer Datei nach dem Vorkommen

eines bestimmten Strings und gibt bei Erfolg die Position zurück, wo der String

gefunden wurde.

}

function ScanFile(const FileName: string;

const forString: string;

caseSensitive: Boolean): Longint;

const

BufferSize = $8001; { 32K+1 bytes }

var

pBuf, pEnd, pScan, pPos: PChar;

filesize: LongInt;

bytesRemaining: LongInt;

bytesToRead: Integer;

F: file;

SearchFor: PChar;

oldMode: Word;

begin

{ assume failure }

Result := -1;

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;

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

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 }

// Search in autoexec.bat for "keyb" with case insensitive

// In der autoexec.bat nach "keyb" suchen

procedure TForm1.Button1Click(Sender: TObject);

var

Position: integer;

begin

Position := ScanFile('c:autoexec.bat', 'keyb', False);

ShowMessage(IntToStr(Position));

end;

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

neoturk: ...How to search a file for a string ?...

{

ScanFile searches for a string in a file and returns the position of the string

in the file or -1, if not found.

ScanFile sucht in einer Datei nach dem Vorkommen

eines bestimmten Strings und gibt bei Erfolg die Position zurück, wo der String

gefunden wurde.

}

function ScanFile(const FileName: string;

const forString: string;

caseSensitive: Boolean): Longint;

const

BufferSize = $8001; { 32K+1 bytes }

var

pBuf, pEnd, pScan, pPos: PChar;

filesize: LongInt;

bytesRemaining: LongInt;

bytesToRead: Integer;

F: file;

SearchFor: PChar;

oldMode: Word;

begin

{ assume failure }

Result := -1;

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;

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

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 }

// Search in autoexec.bat for "keyb" with case insensitive

// In der autoexec.bat nach "keyb" suchen

procedure TForm1.Button1Click(Sender: TObject);

var

Position: integer;

begin

Position := ScanFile('c:autoexec.bat', 'keyb', False);

ShowMessage(IntToStr(Position));

end;

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

neoturk: ...Calculate the checksum of a file ?...

function GetCheckSum(FileName: string): DWORD;

var

F: file of DWORD;

P: Pointer;

Fsize: DWORD;

Buffer: array [0..500] of DWORD;

begin

FileMode := 0;

AssignFile(F, FileName);

Reset(F);

Seek(F, FileSize(F) div 2);

Fsize := FileSize(F) - 1 - FilePos(F);

if Fsize > 500 then Fsize := 500;

BlockRead(F, Buffer, Fsize);

Close(F);

P := @Buffer;

asm

xor eax, eax

xor ecx, ecx

mov edi , p

@again:

add eax, [edi + 4*ecx]

inc ecx

cmp ecx, fsize

jl @again

mov @result, eax

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

ShowMessage(IntToStr(GetCheckSum('c:Autoexec.bat')));

end;

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

neoturk: ...Calculate the checksum of a file ?...

function GetCheckSum(FileName: string): DWORD;

var

F: file of DWORD;

P: Pointer;

Fsize: DWORD;

Buffer: array [0..500] of DWORD;

begin

FileMode := 0;

AssignFile(F, FileName);

Reset(F);

Seek(F, FileSize(F) div 2);

Fsize := FileSize(F) - 1 - FilePos(F);

if Fsize > 500 then Fsize := 500;

BlockRead(F, Buffer, Fsize);

Close(F);

P := @Buffer;

asm

xor eax, eax

xor ecx, ecx

mov edi , p

@again:

add eax, [edi + 4*ecx]

inc ecx

cmp ecx, fsize

jl @again

mov @result, eax

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

ShowMessage(IntToStr(GetCheckSum('c:Autoexec.bat')));

end;

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

neoturk: ...Create a shortcut in the startmenu, on the desktop, ?...

uses

Registry,

ActiveX,

ComObj,

ShlObj;

type

ShortcutType = (_DESKTOP, _QUICKLAUNCH, _SENDTO, _STARTMENU, _OTHERFOLDER);

function CreateShortcut(SourceFileName: string; // the file the shortcut points to

Location: ShortcutType; // shortcut location

SubFolder, // subfolder of location

WorkingDir, // working directory property of the shortcut

Parameters,

Description: string): // description property of the shortcut

string;

const

SHELL_FOLDERS_ROOT = 'SoftwareMicroSoftWindowsCurrentVersionExplorer';

QUICK_LAUNCH_ROOT = 'SoftwareMicroSoftWindowsCurrentVersionGrpConv';

var

MyObject: IUnknown;

MySLink: IShellLink;

MyPFile: IPersistFile;

Directory, LinkName: string;

WFileName: WideString;

Reg: TRegIniFile;

begin

MyObject := CreateComObject(CLSID_ShellLink);

MySLink := MyObject as IShellLink;

MyPFile := MyObject as IPersistFile;

MySLink.SetPath(PChar(SourceFileName));

MySLink.SetArguments(PChar(Parameters));

MySLink.SetDescription(PChar(Description));

LinkName := ChangeFileExt(SourceFileName, '.lnk');

LinkName := ExtractFileName(LinkName);

// Quicklauch

if Location = _QUICKLAUNCH then

begin

Reg := TRegIniFile.Create(QUICK_LAUNCH_ROOT);

try

Directory := Reg.ReadString('MapGroups', 'Quick Launch', '');

finally

Reg.Free;

end;

end

else

// Other locations

begin

Reg := TRegIniFile.Create(SHELL_FOLDERS_ROOT);

try

case Location of

_OTHERFOLDER : Directory := SubFolder;

_DESKTOP : Directory := Reg.ReadString('Shell Folders', 'Desktop', '');

_STARTMENU : Directory := Reg.ReadString('Shell Folders', 'Start Menu', '');

_SENDTO : Directory := Reg.ReadString('Shell Folders', 'SendTo', '');

end;

finally

Reg.Free;

end;

if Directory <> '' then

begin

if (SubFolder <> '') and (Location <> _OTHERFOLDER) then

WFileName := Directory + '' + SubFolder + '' + LinkName

else

WFileName := Directory + '' + LinkName;

if WorkingDir = '' then

MySLink.SetWorkingDirectory(PChar(ExtractFilePath(SourceFileName)))

else

MySLink.SetWorkingDirectory(PChar(WorkingDir));

MyPFile.Save(PWChar(WFileName), False);

Result := WFileName;

end;

function GetProgramDir: string;

var

reg: TRegistry;

begin

reg := TRegistry.Create;

try

reg.RootKey := HKEY_CURRENT_USER;

reg.OpenKey('SoftwareMicrosoftWindowsCurrentVersionExplorerShell Folders', False);

Result := reg.ReadString('Programs');

reg.CloseKey;

finally

reg.Free;

end;

// Some examples:

procedure TForm1.Button1Click(Sender: TObject);

const

PROGR = 'c:YourProgram.exe';

var

resPath: string;

begin

//Create a Shortcut in the Quckick launch toolbar

CreateShortcut(PROGR, _QUICKLAUNCH, '','','','Description');

//Create a Shortcut on the Desktop

CreateShortcut(PROGR, _DESKTOP, '','','','Description');

//Create a Shortcut in the Startmenu /"Programs"-Folder

resPath := CreateShortcut(PROGR, _OTHERFOLDER, GetProgramDir,'','','Description');

if resPath <> '' then

begin

ShowMessage('Shortcut Successfully created in: ' + resPath);

end;

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

neoturk: ...Create a shortcut in the startmenu, on the desktop, ?...

uses

Registry,

ActiveX,

ComObj,

ShlObj;

type

ShortcutType = (_DESKTOP, _QUICKLAUNCH, _SENDTO, _STARTMENU, _OTHERFOLDER);

function CreateShortcut(SourceFileName: string; // the file the shortcut points to

Location: ShortcutType; // shortcut location

SubFolder, // subfolder of location

WorkingDir, // working directory property of the shortcut

Parameters,

Description: string): // description property of the shortcut

string;

const

SHELL_FOLDERS_ROOT = 'SoftwareMicroSoftWindowsCurrentVersionExplorer';

QUICK_LAUNCH_ROOT = 'SoftwareMicroSoftWindowsCurrentVersionGrpConv';

var

MyObject: IUnknown;

MySLink: IShellLink;

MyPFile: IPersistFile;

Directory, LinkName: string;

WFileName: WideString;

Reg: TRegIniFile;

begin

MyObject := CreateComObject(CLSID_ShellLink);

MySLink := MyObject as IShellLink;

MyPFile := MyObject as IPersistFile;

MySLink.SetPath(PChar(SourceFileName));

MySLink.SetArguments(PChar(Parameters));

MySLink.SetDescription(PChar(Description));

LinkName := ChangeFileExt(SourceFileName, '.lnk');

LinkName := ExtractFileName(LinkName);

// Quicklauch

if Location = _QUICKLAUNCH then

begin

Reg := TRegIniFile.Create(QUICK_LAUNCH_ROOT);

try

Directory := Reg.ReadString('MapGroups', 'Quick Launch', '');

finally

Reg.Free;

end;

end

else

// Other locations

begin

Reg := TRegIniFile.Create(SHELL_FOLDERS_ROOT);

try

case Location of

_OTHERFOLDER : Directory := SubFolder;

_DESKTOP : Directory := Reg.ReadString('Shell Folders', 'Desktop', '');

_STARTMENU : Directory := Reg.ReadString('Shell Folders', 'Start Menu', '');

_SENDTO : Directory := Reg.ReadString('Shell Folders', 'SendTo', '');

end;

finally

Reg.Free;

end;

if Directory <> '' then

begin

if (SubFolder <> '') and (Location <> _OTHERFOLDER) then

WFileName := Directory + '' + SubFolder + '' + LinkName

else

WFileName := Directory + '' + LinkName;

if WorkingDir = '' then

MySLink.SetWorkingDirectory(PChar(ExtractFilePath(SourceFileName)))

else

MySLink.SetWorkingDirectory(PChar(WorkingDir));

MyPFile.Save(PWChar(WFileName), False);

Result := WFileName;

end;

function GetProgramDir: string;

var

reg: TRegistry;

begin

reg := TRegistry.Create;

try

reg.RootKey := HKEY_CURRENT_USER;

reg.OpenKey('SoftwareMicrosoftWindowsCurrentVersionExplorerShell Folders', False);

Result := reg.ReadString('Programs');

reg.CloseKey;

finally

reg.Free;

end;

// Some examples:

procedure TForm1.Button1Click(Sender: TObject);

const

PROGR = 'c:YourProgram.exe';

var

resPath: string;

begin

//Create a Shortcut in the Quckick launch toolbar

CreateShortcut(PROGR, _QUICKLAUNCH, '','','','Description');

//Create a Shortcut on the Desktop

CreateShortcut(PROGR, _DESKTOP, '','','','Description');

//Create a Shortcut in the Startmenu /"Programs"-Folder

resPath := CreateShortcut(PROGR, _OTHERFOLDER, GetProgramDir,'','','Description');

if resPath <> '' then

begin

ShowMessage('Shortcut Successfully created in: ' + resPath);

end;

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

neoturk: ...Assign the text of a file to a string ?...

function GetTextFromFile(AFile: string; var Returnstring: string): Boolean;

var

FileStream: TFileStream;

begin

Result := False;

if not FileExists(AFile) then Exit;

FileStream := TFileStream.Create(AFile, fmOpenRead);

try

if FileStream.Size <> 0 then

begin

SetLength(Returnstring, FileStream.Size);

FileStream.Read(Returnstring[1], FileStream.Size);

Result := True;

end;

finally

FileStream.Free;

end;

procedure TForm1.Button1Click(Sender: TObject);

var

s: string;

begin

if GetTextFromFile('c:autoexec.bat', s) then

begin

ShowMessage(s);

// Label1.caption := s; or assign the text to a Label

// Memo1.text := s; or a memo

end;

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

neoturk: ...Assign the text of a file to a string ?...

function GetTextFromFile(AFile: string; var Returnstring: string): Boolean;

var

FileStream: TFileStream;

begin

Result := False;

if not FileExists(AFile) then Exit;

FileStream := TFileStream.Create(AFile, fmOpenRead);

try

if FileStream.Size <> 0 then

begin

SetLength(Returnstring, FileStream.Size);

FileStream.Read(Returnstring[1], FileStream.Size);

Result := True;

end;

finally

FileStream.Free;

end;

procedure TForm1.Button1Click(Sender: TObject);

var

s: string;

begin

if GetTextFromFile('c:autoexec.bat', s) then

begin

ShowMessage(s);

// Label1.caption := s; or assign the text to a Label

// Memo1.text := s; or a memo

end;

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

neoturk: ...Check, if two files are equal ?...

{1.}

function Are2FilesEqual(const File1, File2: TFileName): Boolean;

var

ms1, ms2: TMemoryStream;

begin

Result := False;

ms1 := TMemoryStream.Create;

try

ms1.LoadFromFile(File1);

ms2 := TMemoryStream.Create;

try

ms2.LoadFromFile(File2);

if ms1.Size = ms2.Size then

Result := CompareMem(ms1.Memory, ms2.memory, ms1.Size);

finally

ms2.Free;

end;

finally

ms1.Free;

end

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

if Opendialog1.Execute then

if Opendialog2.Execute then

if Are2FilesEqual(Opendialog1.FileName, Opendialog2.FileName) then

ShowMessage('Files are equal.');

end;

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

{2.}

function FilesAreEqual(const File1, File2: TFileName): Boolean;

const

BlockSize = 65536;

var

fs1, fs2: TFileStream;

L1, L2: Integer;

B1, B2: array[1..BlockSize] of Byte;

begin

Result := False;

fs1 := TFileStream.Create(File1, fmOpenRead or fmShareDenyWrite);

try

fs2 := TFileStream.Create(File2, fmOpenRead or fmShareDenyWrite);

try

if fs1.Size = fs2.Size then

begin

while fs1.Position < fs1.Size do

begin

L1 := fs1.Read(B1[1], BlockSize);

L2 := fs2.Read(B2[1], BlockSize);

if L1 <> L2 then

begin

Exit;

end;

if not CompareMem(@B1[1], @B2[1], L1) then Exit;

end;

Result := True;

end;

finally

fs2.Free;

end;

finally

fs1.Free;

end;

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

neoturk: ...Check, if two files are equal ?...

{1.}

function Are2FilesEqual(const File1, File2: TFileName): Boolean;

var

ms1, ms2: TMemoryStream;

begin

Result := False;

ms1 := TMemoryStream.Create;

try

ms1.LoadFromFile(File1);

ms2 := TMemoryStream.Create;

try

ms2.LoadFromFile(File2);

if ms1.Size = ms2.Size then

Result := CompareMem(ms1.Memory, ms2.memory, ms1.Size);

finally

ms2.Free;

end;

finally

ms1.Free;

end

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

if Opendialog1.Execute then

if Opendialog2.Execute then

if Are2FilesEqual(Opendialog1.FileName, Opendialog2.FileName) then

ShowMessage('Files are equal.');

end;

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

{2.}

function FilesAreEqual(const File1, File2: TFileName): Boolean;

const

BlockSize = 65536;

var

fs1, fs2: TFileStream;

L1, L2: Integer;

B1, B2: array[1..BlockSize] of Byte;

begin

Result := False;

fs1 := TFileStream.Create(File1, fmOpenRead or fmShareDenyWrite);

try

fs2 := TFileStream.Create(File2, fmOpenRead or fmShareDenyWrite);

try

if fs1.Size = fs2.Size then

begin

while fs1.Position < fs1.Size do

begin

L1 := fs1.Read(B1[1], BlockSize);

L2 := fs2.Read(B2[1], BlockSize);

if L1 <> L2 then

begin

Exit;

end;

if not CompareMem(@B1[1], @B2[1], L1) then Exit;

end;

Result := True;

end;

finally

fs2.Free;

end;

finally

fs1.Free;

end;

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

neoturk: ...Delete a file permanently ?...

{

If you want to get rid of a file normally you just delete it.

But someone else can undelete it if the file hasn't been wiped correctly.

For security purposes, to insure that certain files are permanently

gone, the WipeFile procedure writes over the data in the file with

random characters and then erases it.

Wenn man eine Datei nicht mehr braucht, löscht man sie einfach.

Aber jemand anders kann die Datei wieder herstellen, wenn sie

nicht "richtig" gelöscht wurde.

Aus Sicherheitsgründen, um sicherzustellen, dass eine Datei permanent

gelöscht wird, überschreibt die WipeFile Prozedur eine Datei mit

Zufalls-Zeichen und löscht sie anschliessend.

}

procedure WipeFile(FileName: string);

var

buffer: array [0..4095] of Byte;

max, n: LongInt;

i: Integer;

fs: TFileStream;

procedure RandomizeBuffer;

var

i: Integer;

begin

for i := Low(buffer) to High(buffer) do

buffer[i] := Random(256);

end;

begin

fs := TFilestream.Create(FileName, fmOpenReadWrite or fmShareExclusive);

try

for i := 1 to 3 do

begin

RandomizeBuffer;

max := fs.Size;

fs.Position := 0;

while max > 0 do

begin

if max > SizeOf(buffer) then

n := SizeOf(buffer)

else

n := max;

fs.Write(Buffer, n);

max := max - n;

end;

FlushFileBuffers(fs.Handle);

end;

finally

fs.Free;

end;

Deletefile(FileName);

end;

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

neoturk: ...Delete a file permanently ?...

{

If you want to get rid of a file normally you just delete it.

But someone else can undelete it if the file hasn't been wiped correctly.

For security purposes, to insure that certain files are permanently

gone, the WipeFile procedure writes over the data in the file with

random characters and then erases it.

Wenn man eine Datei nicht mehr braucht, löscht man sie einfach.

Aber jemand anders kann die Datei wieder herstellen, wenn sie

nicht "richtig" gelöscht wurde.

Aus Sicherheitsgründen, um sicherzustellen, dass eine Datei permanent

gelöscht wird, überschreibt die WipeFile Prozedur eine Datei mit

Zufalls-Zeichen und löscht sie anschliessend.

}

procedure WipeFile(FileName: string);

var

buffer: array [0..4095] of Byte;

max, n: LongInt;

i: Integer;

fs: TFileStream;

procedure RandomizeBuffer;

var

i: Integer;

begin

for i := Low(buffer) to High(buffer) do

buffer[i] := Random(256);

end;

begin

fs := TFilestream.Create(FileName, fmOpenReadWrite or fmShareExclusive);

try

for i := 1 to 3 do

begin

RandomizeBuffer;

max := fs.Size;

fs.Position := 0;

while max > 0 do

begin

if max > SizeOf(buffer) then

n := SizeOf(buffer)

else

n := max;

fs.Write(Buffer, n);

max := max - n;

end;

FlushFileBuffers(fs.Handle);

end;

finally

fs.Free;

end;

Deletefile(FileName);

end;

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

neoturk: ...Copy files to the windows clipboard ?...

uses

ShlObj, ClipBrd;

procedure CopyFilesToClipboard(FileList: string);

var

DropFiles: PDropFiles;

hGlobal: THandle;

iLen: Integer;

begin

iLen := Length(FileList) + 2;

FileList := FileList + #0#0;

hGlobal := GlobalAlloc(GMEM_SHARE or GMEM_MOVEABLE or GMEM_ZEROINIT,

SizeOf(TDropFiles) + iLen);

if (hGlobal = 0) then raise Exception.Create('Could not allocate memory.');

begin

DropFiles := GlobalLock(hGlobal);

DropFiles^.pFiles := SizeOf(TDropFiles);

Move(FileList[1], (PChar(DropFiles) + SizeOf(TDropFiles))^, iLen);

GlobalUnlock(hGlobal);

Clipboard.SetAsHandle(CF_HDROP, hGlobal);

end;

// Example, Beispiel:

procedure TForm1.Button1Click(Sender: TObject);

begin

CopyFilesToClipboard('C:Bootlog.Txt'#0'C:AutoExec.Bat');

end;

{

Separate the files with a #0.

Dateien mit einem #0 trennen.

}

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

neoturk: ...Copy files to the windows clipboard ?...

uses

ShlObj, ClipBrd;

procedure CopyFilesToClipboard(FileList: string);

var

DropFiles: PDropFiles;

hGlobal: THandle;

iLen: Integer;

begin

iLen := Length(FileList) + 2;

FileList := FileList + #0#0;

hGlobal := GlobalAlloc(GMEM_SHARE or GMEM_MOVEABLE or GMEM_ZEROINIT,

SizeOf(TDropFiles) + iLen);

if (hGlobal = 0) then raise Exception.Create('Could not allocate memory.');

begin

DropFiles := GlobalLock(hGlobal);

DropFiles^.pFiles := SizeOf(TDropFiles);

Move(FileList[1], (PChar(DropFiles) + SizeOf(TDropFiles))^, iLen);

GlobalUnlock(hGlobal);

Clipboard.SetAsHandle(CF_HDROP, hGlobal);

end;

// Example, Beispiel:

procedure TForm1.Button1Click(Sender: TObject);

begin

CopyFilesToClipboard('C:Bootlog.Txt'#0'C:AutoExec.Bat');

end;

{

Separate the files with a #0.

Dateien mit einem #0 trennen.

}

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

neoturk: ...Rename a directory ?...

uses

ShellApi;

procedure RenameDir(DirFrom, DirTo: string);

var

shellinfo: TSHFileOpStruct;

begin

with shellinfo do

begin

Wnd := 0;

wFunc := FO_RENAME;

pFrom := PChar(DirFrom);

pTo := PChar(DirTo);

fFlags := FOF_FILESONLY or FOF_ALLOWUNDO or

FOF_SILENT or FOF_NOCONFIRMATION;

end;

SHFileOperation(shellinfo);

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

RenameDir('C:Dir1', 'C:Dir2');

end;

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

neoturk: ...Rename a directory ?...

uses

ShellApi;

procedure RenameDir(DirFrom, DirTo: string);

var

shellinfo: TSHFileOpStruct;

begin

with shellinfo do

begin

Wnd := 0;

wFunc := FO_RENAME;

pFrom := PChar(DirFrom);

pTo := PChar(DirTo);

fFlags := FOF_FILESONLY or FOF_ALLOWUNDO or

FOF_SILENT or FOF_NOCONFIRMATION;

end;

SHFileOperation(shellinfo);

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

RenameDir('C:Dir1', 'C:Dir2');

end;

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

neoturk: ...Retrieve a shortcut's link information ?...

uses

ShlObj,

ComObj,

ActiveX,

CommCtrl;

type

PShellLinkInfoStruct = ^TShellLinkInfoStruct;

TShellLinkInfoStruct = record

FullPathAndNameOfLinkFile: array[0..MAX_PATH] of Char;

FullPathAndNameOfFileToExecute: array[0..MAX_PATH] of Char;

ParamStringsOfFileToExecute: array[0..MAX_PATH] of Char;

FullPathAndNameOfWorkingDirectroy: array[0..MAX_PATH] of Char;

Description: array[0..MAX_PATH] of Char;

FullPathAndNameOfFileContiningIcon: array[0..MAX_PATH] of Char;

IconIndex: Integer;

HotKey: Word;

ShowCommand: Integer;

FindData: TWIN32FINDDATA;

end;

procedure GetLinkInfo(lpShellLinkInfoStruct: PShellLinkInfoStruct);

var

ShellLink: IShellLink;

PersistFile: IPersistFile;

AnObj: IUnknown;

begin

// access to the two interfaces of the object

AnObj := CreateComObject(CLSID_ShellLink);

ShellLink := AnObj as IShellLink;

PersistFile := AnObj as IPersistFile;

// Opens the specified file and initializes an object from the file contents.

PersistFile.Load(PWChar(WideString(lpShellLinkInfoStruct^.FullPathAndNameOfLinkFile)), 0);

with ShellLink do

begin

// Retrieves the path and file name of a Shell link object.

GetPath(lpShellLinkInfoStruct^.FullPathAndNameOfFileToExecute,

SizeOf(lpShellLinkInfoStruct^.FullPathAndNameOfLinkFile),

lpShellLinkInfoStruct^.FindData,

SLGP_UNCPRIORITY);

// Retrieves the description string for a Shell link object.

GetDescription(lpShellLinkInfoStruct^.Description,

SizeOf(lpShellLinkInfoStruct^.Description));

// Retrieves the command-line arguments associated with a Shell link object.

GetArguments(lpShellLinkInfoStruct^.ParamStringsOfFileToExecute,

SizeOf(lpShellLinkInfoStruct^.ParamStringsOfFileToExecute));

// Retrieves the name of the working directory for a Shell link object.

GetWorkingDirectory(lpShellLinkInfoStruct^.FullPathAndNameOfWorkingDirectroy,

SizeOf(lpShellLinkInfoStruct^.FullPathAndNameOfWorkingDirectroy));

// Retrieves the location (path and index) of the icon for a Shell link object.

GetIconLocation(lpShellLinkInfoStruct^.FullPathAndNameOfFileContiningIcon,

SizeOf(lpShellLinkInfoStruct^.FullPathAndNameOfFileContiningIcon),

lpShellLinkInfoStruct^.IconIndex);

// Retrieves the hot key for a Shell link object.

GetHotKey(lpShellLinkInfoStruct^.HotKey);

// Retrieves the show (SW_) command for a Shell link object.

GetShowCmd(lpShellLinkInfoStruct^.ShowCommand);

end;

procedure TForm1.Button1Click(Sender: TObject);

const

br = #13#10;

var

LinkInfo: TShellLinkInfoStruct;

s: string;

begin

FillChar(LinkInfo, SizeOf(LinkInfo), #0);

LinkInfo.FullPathAndNameOfLinkFile := 'C:WINNTProfilesuserDesktopFileName.lnk';

GetLinkInfo(@LinkInfo);

with LinkInfo do

s := FullPathAndNameOfLinkFile + br +

FullPathAndNameOfFileToExecute + br +

ParamStringsOfFileToExecute + br +

FullPathAndNameOfWorkingDirectroy + br +

Description + br +

FullPathAndNameOfFileContiningIcon + br +

IntToStr(IconIndex) + br +

IntToStr(LoByte(HotKey)) + br +

IntToStr(HiByte(HotKey)) + br +

IntToStr(ShowCommand) + br +

FindData.cFileName + br +

FindData.cAlternateFileName;

Memo1.Lines.Add(s);

end;

// Only for D3 or higher.

// for D1,D2 users: http://www.hitekdev.com/delphi/shellutlexamples.html