Kod: Tümünü seç
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;Kod: Tümünü seç
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;
end;
procedure TForm1.Button1Click(Sender: TObject);
const
br = #13#10;
var
LinkInfo: TShellLinkInfoStruct;
s: string;
begin
FillChar(LinkInfo, SizeOf(LinkInfo), #0);
LinkInfo.FullPathAndNameOfLinkFile := 'C:\WINNT\Profiles\user\Desktop\FileName.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
Kod: Tümünü seç
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
type
TForm1 = class(TForm)
private
FClientInstance: TFarProc;
FPrevClientProc: TFarProc;
BkBrush: HBRUSH;
procedure ClientWndProc(var Message: TMessage);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
implementation
{$R *.dfm}
constructor TForm1.Create(AOwner: TComponent);
begin
inherited;
BkBrush := CreateSolidBrush(clGray);
FClientInstance := Classes.MakeObjectInstance(ClientWndProc);
FPrevClientProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
SetWindowLong(ClientHandle, GWL_WNDPROC, Longint(FClientInstance));
end;
destructor TForm1.Destroy;
begin
DeleteObject(BkBrush);
inherited;
end;
procedure TForm1.ClientWndProc(var Message: TMessage);
var
DC: HDC;
BrushOld: HBRUSH;
begin
with Message do
begin
case Msg of
WM_ERASEBKGND:
begin
DC := TWMEraseBkGnd(Message).DC;
BrushOld := SelectObject(DC, BkBrush);
FillRect(DC, ClientRect, BkBrush);
SelectObject(DC, BrushOld);
Result := 1;
end;
else
Result := CallWindowProc(FPrevClientProc, ClientHandle, Msg, wParam, lParam);
end;
end;
end;
end.
Kod: Tümünü seç
{
Ausgehend von einer Tabelle, deren Spalten durch einem festgelegten Zeichen getrennt sind
wird ein StringGrid wie folgt automatisch aufgebaut.
If you have to import a simple textfile table (with a well defined field separator)
in your StringGrid, you can manage it like this.
}
procedure ReadTabFile(FN: TFileName; FieldSeparator: Char; SG: TStringGrid);
var
i: Integer;
S: string;
T: string;
Colonne, ligne: Integer;
Les_Strings: TStringList;
CountCols: Integer;
CountLines: Integer;
TabPos: Integer;
StartPos: Integer;
InitialCol: Integer;
begin
Les_Strings := TStringList.Create;
try
// Load the file, Datei laden
Les_Strings.LoadFromFile(FN);
// Get the number of rows, Anzahl der Zeilen ermitteln
CountLines := Les_Strings.Count + SG.FixedRows;
// Get the number of columns, Anzahl der Spalten ermitteln
T := Les_Strings[0];
for i := 0 to Length(T) - 1 do Inc(CountCols, Ord(IsDelimiter(FieldSeparator, T, i)));
Inc(CountCols, 1 + SG.FixedCols);
// Adjust Grid dimensions, Anpassung der Grid-Größe
if CountLines > SG.RowCount then SG.RowCount := CountLines;
if CountCols > SG.ColCount then SG.ColCount := CountCols;
// Initialisierung
InitialCol := SG.FixedCols - 1;
Ligne := SG.FixedRows - 1;
// Iterate through all rows of the table
// Schleife durch allen Zeilen der Tabelle
for i := 0 to Les_Strings.Count - 1 do
begin
Colonne := InitialCol;
Inc(Ligne);
StartPos := 1;
S := Les_Strings[i];
TabPos := Pos(FieldSeparator, S);
repeat
Inc(Colonne);
SG.Cells[Colonne, Ligne] := Copy(S, StartPos, TabPos - 1);
S := Copy(S, TabPos + 1, 999);
TabPos := Pos(FieldSeparator, S);
until TabPos = 0;
end;
finally
Les_Strings.Free;
end;
end;
// Example, Beispiel:
procedure TForm1.Button1Click(Sender: TObject);
begin
Screen.Cursor := crHourGlass;
// Open tab-delimited files
ReadTabFile('C:\TEST.TXT', #9, StringGrid1);
Screen.Cursor := crDefault;
end;Kod: Tümünü seç
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;Kod: Tümünü seç
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;
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,
0,
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:\temp\MyFolder', now, now, now);
end;
Kod: Tümünü seç
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;
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;
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;
end;
Kod: Tümünü seç
{
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;Kod: Tümünü seç
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.
}
[quote][/quote]Kod: Tümünü seç
uses
ShlObj;
procedure TForm1.Button1Click(Sender: TObject);
begin
SHAddToRecentDocs(0, nil);
end;
Kod: Tümünü seç
{
"If I use the windows Explorer to copy a file,
how can I use a paste function in my app?
This code retrieves the filenames in the clipboard.
Now you may want to display a file in a memo or
do something else with it.
"Wenn ich im Windows Explorer eine Datei kopiere,
wie kann ich dann eine Einfüge Funktion implementieren ?
Der folgende Code listet alle Dateinamen in der Zwischenablage auf.
Dann kann man eine Datei z.B in ein Memo laden oder
etwas anderes damit anstellen.
}
uses
clipbrd, shellapi;
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
f: THandle;
buffer: array [0..MAX_PATH] of Char;
i, numFiles: Integer;
begin
if not Clipboard.HasFormat(CF_HDROP) then Exit;
Clipboard.Open;
try
f := Clipboard.GetAsHandle(CF_HDROP);
if f <> 0 then
begin
numFiles := DragQueryFile(f, $FFFFFFFF, nil, 0);
memo1.Clear;
for i := 0 to numfiles - 1 do
begin
buffer[0] := #0;
DragQueryFile(f, i, buffer, SizeOf(buffer));
memo1.Lines.Add(buffer);
end;
end;
finally
Clipboard.Close;
end;
end;
Kod: Tümünü seç
procedure TForm1.Button1Click(Sender: TObject);
var
sl: TStringList;
begin
sl := TStringList.Create;
try
sl.LoadFromFile('c:\afile.txt');
Memo1.SetSelTextBuf(PChar(sl.Text));
finally
sl.Free;
end;
end;
Kod: Tümünü seç
{
These are three utility functions to write strings to a TStream.
Nothing fancy, but I just ended up coding this repeatedly so
I made these functions. }
{
Hier sind einige TStreaam Hilfsfunktionen um strings
in einen TStream zu schreiben.
}
unit ClassUtils;
interface
uses
SysUtils,
Classes;
{: Write a string to the stream
@param Stream is the TStream to write to.
@param s is the string to write
@returns the number of bytes written. }
function Writestring(_Stream: TStream; const _s: string): Integer;
{: Write a string to the stream appending CRLF
@param Stream is the TStream to write to.
@param s is the string to write
@returns the number of bytes written. }
function WritestringLn(_Stream: TStream; const _s: string): Integer;
{: Write formatted data to the stream appending CRLF
@param Stream is the TStream to write to.
@param Format is a format string as used in sysutils.format
@param Args is an array of const as used in sysutils.format
@returns the number of bytes written. }
function WriteFmtLn(_Stream: TStream; const _Format: string;
_Args: array of const): Integer;
implementation
function Writestring(_Stream: TStream; const _s: string): Integer;
begin
Result := _Stream.Write(PChar(_s)^, Length(_s));
end;
function WritestringLn(_Stream: TStream; const _s: string): Integer;
begin
Result := Writestring(_Stream, _s);
Result := Result + Writestring(_Stream, #13#10);
end;
function WriteFmtLn(_Stream: TStream; const _Format: string;
_Args: array of const): Integer;
begin
Result := WritestringLn(_Stream, Format(_Format, _Args));
end;
Kod: Tümünü seç
{
The CopyFile function copies an existing file to a new file.
CopyFile(
lpExistingFileName : PChar, // name of an existing file
lpNewFileName : PChar, // name of new file
bFailIfExists : Boolean); // operation if file exists
bFailIfExists:
Specifies how this operation is to proceed if a file of the same name as
that specified by lpNewFileName already exists.
If this parameter is TRUE and the new file already exists, the function fails.
If this parameter is FALSE and the new file already exists,
the function overwrites the existing file and succeeds.
}
var
fileSource, fileDest: string;
begin
fileSource := 'C:\SourceFile.txt';
fileDest := 'G:\DestFile.txt';
CopyFile(PChar(fileSource), PChar(fileDest), False);
end;Kod: Tümünü seç
function AppendOrWriteTextToFile(FileName : TFilename; WriteText : string): boolean;
var
f : Textfile;
begin
Result := False;
AssignFile(f, FileName);
try
if FileExists(FileName) = False then
Rewrite(f)
else
begin
Append(f);
end;
Writeln(f, WriteText);
Result := True;
finally
CloseFile(f);
end;
end;
// Sample Source...
procedure TForm1.Close1Click(Sender : TObject);
var
dir, log : string;
begin
dir := ExtractFilePath(Application.Exename);
log := 'Last Programm Termination: ' + DateTimeToStr(now);
AppendOrWriteTextToFile(dir + '\logfile.txt', log)
end;