neoturk: ...Enumerate drives on a computer ?...
{
Adds all fixed drives into Combobox1.
To enumerate another type of drive,
i.e all CD-ROMs just change the DRIVE_FIXED constant to DRIVE_CDROM.
Fügt all fixen Laufwerke in Combobox1 ein.
Um z.B alle CD-Rom Laufwerke zu ermitteln,
einfach DRIVE_CDROM anstatt die Konstante DRIVE_FIXED nehmen.
}
procedure List_Drives;
const
DRIVE_UNKNOWN = 0;
DRIVE_NO_ROOT_DIR = 1;
DRIVE_REMOVABLE = 2;
DRIVE_FIXED = 3;
DRIVE_REMOTE = 4;
DRIVE_CDROM = 5;
DRIVE_RAMDISK = 6;
var
r: LongWord;
Drives: array[0..128] of char;
pDrive: PChar;
begin
r := GetLogicalDriveStrings(SizeOf(Drives), Drives);
if r = 0 then Exit;
if r > SizeOf(Drives) then
raise Exception.Create(SysErrorMessage(ERROR_OUTOFMEMORY));
pDrive := Drives;
while pDrive^ <> #0 do
begin
if GetDriveType(pDrive) = DRIVE_FIXED then
Form1.ComboBox1.Items.Add(pDrive);
Inc(pDrive, 4);
end;
end;
Delphi - .....................................
neoturk: ...Enumerate drives on a computer ?...
{
Adds all fixed drives into Combobox1.
To enumerate another type of drive,
i.e all CD-ROMs just change the DRIVE_FIXED constant to DRIVE_CDROM.
Fügt all fixen Laufwerke in Combobox1 ein.
Um z.B alle CD-Rom Laufwerke zu ermitteln,
einfach DRIVE_CDROM anstatt die Konstante DRIVE_FIXED nehmen.
}
procedure List_Drives;
const
DRIVE_UNKNOWN = 0;
DRIVE_NO_ROOT_DIR = 1;
DRIVE_REMOVABLE = 2;
DRIVE_FIXED = 3;
DRIVE_REMOTE = 4;
DRIVE_CDROM = 5;
DRIVE_RAMDISK = 6;
var
r: LongWord;
Drives: array[0..128] of char;
pDrive: PChar;
begin
r := GetLogicalDriveStrings(SizeOf(Drives), Drives);
if r = 0 then Exit;
if r > SizeOf(Drives) then
raise Exception.Create(SysErrorMessage(ERROR_OUTOFMEMORY));
pDrive := Drives;
while pDrive^ <> #0 do
begin
if GetDriveType(pDrive) = DRIVE_FIXED then
Form1.ComboBox1.Items.Add(pDrive);
Inc(pDrive, 4);
end;
end;
Delphi - .....................................
neoturk: ...Register a menu entry to a file ?...
uses
Registry;
procedure AddFileMenue(FilePrefix, Menue, Command: string);
var
reg: TRegistry;
typ: string;
begin
reg := TRegistry.Create;
with reg do
begin
RootKey := HKEY_CLASSES_ROOT;
OpenKey('.' + FilePrefix, True);
typ := ReadString('');
if typ = '' then
begin
typ := Fileprefix + 'file';
WriteString('', typ);
end;
CloseKey;
OpenKey(typ + 'shell' + Menue + 'command', True);
WriteString('', command + ' "%1"');
CloseKey;
Free;
end;
end;
procedure DeleteFileMenue(Fileprefix, Menue: string);
var
reg: TRegistry;
typ: string;
begin
reg := TRegistry.Create;
with reg do
begin
RootKey := HKEY_CLASSES_ROOT;
OpenKey('.' + Fileprefix, True);
typ := ReadString('');
CloseKey;
OpenKey(typ + 'shell', True);
DeleteKey(Menue);
CloseKey;
Free;
end;
end;
{ Example / Beispiel:}
procedure TForm1.Button1Click(Sender: TObject);
begin
{ Register the Menuepoint: }
AddFileMenue('rtf', 'Edit with Notepad', 'C:Windowssystemnotepad.exe');
{
If you now click with the right mousebutton on a *.rtf-file then
you can see a Menuepoint: "Edit with Notepad".
When Click on that point Notepad opens the file.
Wenn man nun mit der rechten Maustaste im Explorer auf eine *.rtf-Datei Clickt,
dann erscheint dort der Menuepunkt "Edit with Notepad".
Beim Clicken darauf, öffnet Notepad diese Datei.
}
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
{
Unregister the Menuepoint / Undo your changes in the Registry:
Löscht den Menuepunkt wieder aus der Registry:
}
DeleteFileMenue('rtf', 'Edit with Notepad');
end;
Delphi - .....................................
neoturk: ...Register a menu entry to a file ?...
uses
Registry;
procedure AddFileMenue(FilePrefix, Menue, Command: string);
var
reg: TRegistry;
typ: string;
begin
reg := TRegistry.Create;
with reg do
begin
RootKey := HKEY_CLASSES_ROOT;
OpenKey('.' + FilePrefix, True);
typ := ReadString('');
if typ = '' then
begin
typ := Fileprefix + 'file';
WriteString('', typ);
end;
CloseKey;
OpenKey(typ + 'shell' + Menue + 'command', True);
WriteString('', command + ' "%1"');
CloseKey;
Free;
end;
end;
procedure DeleteFileMenue(Fileprefix, Menue: string);
var
reg: TRegistry;
typ: string;
begin
reg := TRegistry.Create;
with reg do
begin
RootKey := HKEY_CLASSES_ROOT;
OpenKey('.' + Fileprefix, True);
typ := ReadString('');
CloseKey;
OpenKey(typ + 'shell', True);
DeleteKey(Menue);
CloseKey;
Free;
end;
end;
{ Example / Beispiel:}
procedure TForm1.Button1Click(Sender: TObject);
begin
{ Register the Menuepoint: }
AddFileMenue('rtf', 'Edit with Notepad', 'C:Windowssystemnotepad.exe');
{
If you now click with the right mousebutton on a *.rtf-file then
you can see a Menuepoint: "Edit with Notepad".
When Click on that point Notepad opens the file.
Wenn man nun mit der rechten Maustaste im Explorer auf eine *.rtf-Datei Clickt,
dann erscheint dort der Menuepunkt "Edit with Notepad".
Beim Clicken darauf, öffnet Notepad diese Datei.
}
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
{
Unregister the Menuepoint / Undo your changes in the Registry:
Löscht den Menuepunkt wieder aus der Registry:
}
DeleteFileMenue('rtf', 'Edit with Notepad');
end;
Delphi - .....................................
neoturk: ...How to accept dropped files from the explorer ?...
{
This way you can drag and drop files to a specific control in a Delphi form.
Just create a project and add a ListBox component to Form1.}
{ 1. First, a procedure to handle the message but without handling it. }
interface
procedure WMDROPFILES(var Msg: TMessage);
implementation
procedure TForm1.WMDROPFILES(var Msg: TWMDropFiles);
var
pcFileName: PChar;
i, iSize, iFileCount: integer;
begin
pcFileName := ''; // to avoid compiler warning message
iFileCount := DragQueryFile(Msg.wParam, $FFFFFFFF, pcFileName, 255);
for i := 0 to iFileCount - 1 do
begin
iSize := DragQueryFile(Msg.wParam, i, nil, 0) + 1;
pcFileName := StrAlloc(iSize);
DragQueryFile(Msg.wParam, i, pcFileName, iSize);
if FileExists(pcFileName) then
AddFile(pcFileName); // method to add each file
StrDispose(pcFileName);
end;
DragFinish(Msg.wParam);
end;
{
2. Second, a WindowProc method to replace ListBox1 WindowProc default method
and a variable to store ListBox1 WindowProc default method.
}
interface
procedure LBWindowProc(var Message: TMessage);
implementation
var
OldLBWindowProc: TWndMethod;
procedure TForm1.LBWindowProc(var Message: TMessage);
begin
if Message.Msg = WM_DROPFILES then
WMDROPFILES(Message); // handle WM_DROPFILES message
OldLBWindowProc(Message);
// call default ListBox1 WindowProc method to handle all other messages
end;
{3. In Form1 OnCreate event, initialize all.}
procedure TForm1.FormCreate(Sender: TObject);
begin
OldLBWindowProc := ListBox1.WindowProc; // store defualt WindowProc
ListBox1.WindowProc := LBWindowProc; // replace default WindowProc
DragAcceptFiles(ListBox1.Handle, True); // now ListBox1 accept dropped files
end;
{4. In Form1 OnDestroy event, uninitialize all. Not necesary but a good practice.}
procedure TForm1.FormDestroy(Sender: TObject);
begin
ListBox1.WindowProc := OldLBWindowProc;
DragAcceptFiles(ListBox1.Handle, False);
end;
{5. To complete source code, the AddFile method.}
interface
procedure AddFile(sFileName: string);
implementation
procedure TForm1.AddFile(sFileName: string);
begin
ListBox1.Items.Add(sFilename);
end;
{6. Do not forget to add ShellAPI unit to the uses clause. }
Complete code
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
ListBox1: TListBox;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
procedure WMDROPFILES(var Msg: TMessage);
procedure LBWindowProc(var Message: TMessage);
procedure AddFile(sFileName: string);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
uses
ShellAPI;
var
OldLBWindowProc: TWndMethod;
procedure TForm1.AddFile(sFileName: string);
begin
ListBox1.Items.Add(sFilename);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
OldLBWindowProc := ListBox1.WindowProc; // store defualt WindowProc
ListBox1.WindowProc := LBWindowProc; // replace default WindowProc
DragAcceptFiles(ListBox1.Handle, True); // now ListBox1 accept dropped files
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
ListBox1.WindowProc := OldLBWindowProc;
DragAcceptFiles(ListBox1.Handle, False);
end;
procedure TForm1.LBWindowProc(var Message: TMessage);
begin
if Message.Msg = WM_DROPFILES then
WMDROPFILES(Message); // handle WM_DROPFILES message
OldLBWindowProc(Message);
// call default ListBox1 WindowProc method to handle all other messages
end;
procedure TForm1.WMDROPFILES(var Msg: TMessage);
var
pcFileName: PChar;
i, iSize, iFileCount: integer;
begin
pcFileName := ''; // to avoid compiler warning message
iFileCount := DragQueryFile(Msg.wParam, $FFFFFFFF, pcFileName, 255);
for i := 0 to iFileCount - 1 do
begin
iSize := DragQueryFile(Msg.wParam, i, nil, 0) + 1;
pcFileName := StrAlloc(iSize);
DragQueryFile(Msg.wParam, i, pcFileName, iSize);
if FileExists(pcFileName) then
AddFile(pcFileName); // method to add each file
StrDispose(pcFileName);
end;
DragFinish(Msg.wParam);
end;
end.
Delphi - .....................................
neoturk: ...How to accept dropped files from the explorer ?...
{
This way you can drag and drop files to a specific control in a Delphi form.
Just create a project and add a ListBox component to Form1.}
{ 1. First, a procedure to handle the message but without handling it. }
interface
procedure WMDROPFILES(var Msg: TMessage);
implementation
procedure TForm1.WMDROPFILES(var Msg: TWMDropFiles);
var
pcFileName: PChar;
i, iSize, iFileCount: integer;
begin
pcFileName := ''; // to avoid compiler warning message
iFileCount := DragQueryFile(Msg.wParam, $FFFFFFFF, pcFileName, 255);
for i := 0 to iFileCount - 1 do
begin
iSize := DragQueryFile(Msg.wParam, i, nil, 0) + 1;
pcFileName := StrAlloc(iSize);
DragQueryFile(Msg.wParam, i, pcFileName, iSize);
if FileExists(pcFileName) then
AddFile(pcFileName); // method to add each file
StrDispose(pcFileName);
end;
DragFinish(Msg.wParam);
end;
{
2. Second, a WindowProc method to replace ListBox1 WindowProc default method
and a variable to store ListBox1 WindowProc default method.
}
interface
procedure LBWindowProc(var Message: TMessage);
implementation
var
OldLBWindowProc: TWndMethod;
procedure TForm1.LBWindowProc(var Message: TMessage);
begin
if Message.Msg = WM_DROPFILES then
WMDROPFILES(Message); // handle WM_DROPFILES message
OldLBWindowProc(Message);
// call default ListBox1 WindowProc method to handle all other messages
end;
{3. In Form1 OnCreate event, initialize all.}
procedure TForm1.FormCreate(Sender: TObject);
begin
OldLBWindowProc := ListBox1.WindowProc; // store defualt WindowProc
ListBox1.WindowProc := LBWindowProc; // replace default WindowProc
DragAcceptFiles(ListBox1.Handle, True); // now ListBox1 accept dropped files
end;
{4. In Form1 OnDestroy event, uninitialize all. Not necesary but a good practice.}
procedure TForm1.FormDestroy(Sender: TObject);
begin
ListBox1.WindowProc := OldLBWindowProc;
DragAcceptFiles(ListBox1.Handle, False);
end;
{5. To complete source code, the AddFile method.}
interface
procedure AddFile(sFileName: string);
implementation
procedure TForm1.AddFile(sFileName: string);
begin
ListBox1.Items.Add(sFilename);
end;
{6. Do not forget to add ShellAPI unit to the uses clause. }
Complete code
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
ListBox1: TListBox;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
procedure WMDROPFILES(var Msg: TMessage);
procedure LBWindowProc(var Message: TMessage);
procedure AddFile(sFileName: string);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
uses
ShellAPI;
var
OldLBWindowProc: TWndMethod;
procedure TForm1.AddFile(sFileName: string);
begin
ListBox1.Items.Add(sFilename);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
OldLBWindowProc := ListBox1.WindowProc; // store defualt WindowProc
ListBox1.WindowProc := LBWindowProc; // replace default WindowProc
DragAcceptFiles(ListBox1.Handle, True); // now ListBox1 accept dropped files
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
ListBox1.WindowProc := OldLBWindowProc;
DragAcceptFiles(ListBox1.Handle, False);
end;
procedure TForm1.LBWindowProc(var Message: TMessage);
begin
if Message.Msg = WM_DROPFILES then
WMDROPFILES(Message); // handle WM_DROPFILES message
OldLBWindowProc(Message);
// call default ListBox1 WindowProc method to handle all other messages
end;
procedure TForm1.WMDROPFILES(var Msg: TMessage);
var
pcFileName: PChar;
i, iSize, iFileCount: integer;
begin
pcFileName := ''; // to avoid compiler warning message
iFileCount := DragQueryFile(Msg.wParam, $FFFFFFFF, pcFileName, 255);
for i := 0 to iFileCount - 1 do
begin
iSize := DragQueryFile(Msg.wParam, i, nil, 0) + 1;
pcFileName := StrAlloc(iSize);
DragQueryFile(Msg.wParam, i, pcFileName, iSize);
if FileExists(pcFileName) then
AddFile(pcFileName); // method to add each file
StrDispose(pcFileName);
end;
DragFinish(Msg.wParam);
end;
end.
Delphi - .....................................
neoturk: ...Disable the close [x] button on a form ?...
procedure TFMain.FormCreate(Sender: TObject);
var
hMenuHandle: Integer;
begin
hMenuHandle := GetSystemMenu(Handle, False);
if (hMenuHandle <> 0) then
DeleteMenu(hMenuHandle, SC_CLOSE, MF_BYCOMMAND);
end;
Delphi - .....................................
neoturk: ...Disable the close [x] button on a form ?...
procedure TFMain.FormCreate(Sender: TObject);
var
hMenuHandle: Integer;
begin
hMenuHandle := GetSystemMenu(Handle, False);
if (hMenuHandle <> 0) then
DeleteMenu(hMenuHandle, SC_CLOSE, MF_BYCOMMAND);
end;
Delphi - .....................................
neoturk: ...Open the windows explorer and show the specified folder ?...
uses
ShellApi;
// strFolder is the folder you want to open
procedure ShowFolder(strFolder: string);
begin
ShellExecute(Application.Handle,
PChar('explore'),
PChar(strFolder),
nil,
nil,
SW_SHOWNORMAL);
end;
procedure TForm1.Button1Click(Sender: TObject);
const
strFolder = 'c:My Documents';
begin
ShowFolder(strFolder);
end;
Delphi - .....................................
neoturk: ...Open the windows explorer and show the specified folder ?...
uses
ShellApi;
// strFolder is the folder you want to open
procedure ShowFolder(strFolder: string);
begin
ShellExecute(Application.Handle,
PChar('explore'),
PChar(strFolder),
nil,
nil,
SW_SHOWNORMAL);
end;
procedure TForm1.Button1Click(Sender: TObject);
const
strFolder = 'c:My Documents';
begin
ShowFolder(strFolder);
end;
Delphi - .....................................
neoturk: ...Run a program or open an associated file ?...
{ Open a file or starts a programm (without parameters) }
procedure OpenFile(FileName: string);
var
c: array[0..800] of Char;
begin
StrPCopy(c, FileName);
ShellExecute(Application.Handle, 'open', c, nil, nil, SW_NORMAL);
end;
{ Starts a programm with commandline parameters }
procedure OpenProgram(prog, params: string);
var
c, p: array[0..800] of Char;
begin
StrPCopy(c, prog);
StrPCopy(p, params);
ShellExecute(Application.Handle, 'open', c, p, nil, SW_NORMAL);
end;
{ Starts a program and wait until its terminated:
WindowState is of the SW_xxx constants }
function ExecAndWait(const FileName, Params: string;
WindowState: Word): Boolean;
var
SUInfo: TStartupInfo;
ProcInfo: TProcessInformation;
CmdLine: string;
begin
{ Enclose filename in quotes to take care of
long filenames with spaces. }
CmdLine := '"' + FileName + '"' + Params;
FillChar(SUInfo, SizeOf(SUInfo), #0);
with SUInfo do
begin
cb := SizeOf(SUInfo);
dwFlags := STARTF_USESHOWWINDOW;
wShowWindow := WindowState;
end;
Result := CreateProcess(nil, PChar(CmdLine), nil, nil, False,
CREATE_NEW_CONSOLE or
NORMAL_PRIORITY_CLASS, nil,
PChar(ExtractFilePath(FileName)),
SUInfo, ProcInfo);
{ Wait for it to finish. }
if Result then
WaitForSingleObject(ProcInfo.hProcess, INFINITE);
end;
{ Execute a complete shell command line and waits until terminated. }
function ExecCmdLineAndWait(const CmdLine: string;
WindowState: Word): Boolean;
var
SUInfo: TStartupInfo;
ProcInfo: TProcessInformation;
begin
{ Enclose filename in quotes to take care of
long filenames with spaces. }
FillChar(SUInfo, SizeOf(SUInfo), #0);
with SUInfo do
begin
cb := SizeOf(SUInfo);
dwFlags := STARTF_USESHOWWINDOW;
wShowWindow := WindowState;
end;
Result := CreateProcess(nil, PChar(CmdLine), nil, nil, False,
CREATE_NEW_CONSOLE or
NORMAL_PRIORITY_CLASS, nil,
nil {PChar(ExtractFilePath(Filename))},
SUInfo, ProcInfo);
{ Wait for it to finish. }
if Result then
WaitForSingleObject(ProcInfo.hProcess, INFINITE);
end;
{ Execute a complete shell command line without waiting. }
function OpenCmdLine(const CmdLine: string;
WindowState: Word): Boolean;
var
SUInfo: TStartupInfo;
ProcInfo: TProcessInformation;
begin
{ Enclose filename in quotes to take care of
long filenames with spaces. }
FillChar(SUInfo, SizeOf(SUInfo), #0);
with SUInfo do
begin
cb := SizeOf(SUInfo);
dwFlags := STARTF_USESHOWWINDOW;
wShowWindow := WindowState;
end;
Result := CreateProcess(nil, PChar(CmdLine), nil, nil, False,
CREATE_NEW_CONSOLE or
NORMAL_PRIORITY_CLASS, nil,
nil {PChar(ExtractFilePath(Filename))},
SUInfo, ProcInfo);
end;
Delphi - .....................................
neoturk: ...Run a program or open an associated file ?...
{ Open a file or starts a programm (without parameters) }
procedure OpenFile(FileName: string);
var
c: array[0..800] of Char;
begin
StrPCopy(c, FileName);
ShellExecute(Application.Handle, 'open', c, nil, nil, SW_NORMAL);
end;
{ Starts a programm with commandline parameters }
procedure OpenProgram(prog, params: string);
var
c, p: array[0..800] of Char;
begin
StrPCopy(c, prog);
StrPCopy(p, params);
ShellExecute(Application.Handle, 'open', c, p, nil, SW_NORMAL);
end;
{ Starts a program and wait until its terminated:
WindowState is of the SW_xxx constants }
function ExecAndWait(const FileName, Params: string;
WindowState: Word): Boolean;
var
SUInfo: TStartupInfo;
ProcInfo: TProcessInformation;
CmdLine: string;
begin
{ Enclose filename in quotes to take care of
long filenames with spaces. }
CmdLine := '"' + FileName + '"' + Params;
FillChar(SUInfo, SizeOf(SUInfo), #0);
with SUInfo do
begin
cb := SizeOf(SUInfo);
dwFlags := STARTF_USESHOWWINDOW;
wShowWindow := WindowState;
end;
Result := CreateProcess(nil, PChar(CmdLine), nil, nil, False,
CREATE_NEW_CONSOLE or
NORMAL_PRIORITY_CLASS, nil,
PChar(ExtractFilePath(FileName)),
SUInfo, ProcInfo);
{ Wait for it to finish. }
if Result then
WaitForSingleObject(ProcInfo.hProcess, INFINITE);
end;
{ Execute a complete shell command line and waits until terminated. }
function ExecCmdLineAndWait(const CmdLine: string;
WindowState: Word): Boolean;
var
SUInfo: TStartupInfo;
ProcInfo: TProcessInformation;
begin
{ Enclose filename in quotes to take care of
long filenames with spaces. }
FillChar(SUInfo, SizeOf(SUInfo), #0);
with SUInfo do
begin
cb := SizeOf(SUInfo);
dwFlags := STARTF_USESHOWWINDOW;
wShowWindow := WindowState;
end;
Result := CreateProcess(nil, PChar(CmdLine), nil, nil, False,
CREATE_NEW_CONSOLE or
NORMAL_PRIORITY_CLASS, nil,
nil {PChar(ExtractFilePath(Filename))},
SUInfo, ProcInfo);
{ Wait for it to finish. }
if Result then
WaitForSingleObject(ProcInfo.hProcess, INFINITE);
end;
{ Execute a complete shell command line without waiting. }
function OpenCmdLine(const CmdLine: string;
WindowState: Word): Boolean;
var
SUInfo: TStartupInfo;
ProcInfo: TProcessInformation;
begin
{ Enclose filename in quotes to take care of
long filenames with spaces. }
FillChar(SUInfo, SizeOf(SUInfo), #0);
with SUInfo do
begin
cb := SizeOf(SUInfo);
dwFlags := STARTF_USESHOWWINDOW;
wShowWindow := WindowState;
end;
Result := CreateProcess(nil, PChar(CmdLine), nil, nil, False,
CREATE_NEW_CONSOLE or
NORMAL_PRIORITY_CLASS, nil,
nil {PChar(ExtractFilePath(Filename))},
SUInfo, ProcInfo);
end;
Delphi - .....................................
neoturk: ...Use tfilestream ?...
type
TPerson = record
Name: string[50];
vorname: string[50];
end;
TComputer = record
Name: string[30];
cpu: string[30];
end;
var
Form1: TForm1;
Person: TPerson;
Computer: TComputer;
Stream: TFileStream;
implementation
{$R *.DFM}
//Speichern resp. Erstellen von Datei
//Save or create the file
procedure TForm1.Button1Click(Sender: TObject);
begin
try
Stream := TFileStream.Create('c:test.dat', fmOpenReadWrite);
except
Stream := TFileStream.Create('c:test.dat', fmCreate);
end;
//2 Einträge pro Record
//save 2 records for TPerson and TComputer
Person.Name := 'Grossenbacher';
Person.vorname := 'Simon';
Stream.WriteBuffer(Person, SizeOf(TPerson));
Person.Name := 'Stutz';
Person.vorname := 'Thomas';
Stream.WriteBuffer(Person, SizeOf(TPerson));
Computer.Name := 'Delphi';
Computer.cpu := 'Intel';
Stream.WriteBuffer(Computer, SizeOf(TComputer));
Computer.Name := 'Win';
Computer.cpu := 'AMD';
Stream.WriteBuffer(Computer, SizeOf(TComputer));
Stream.Free;
end;
//lädt alle daten von TPerson in listbox1 und
//daten von TComputer in Listbox2
//load records from TPerson to listbox1 and
//load records from TComputer to listbox2
procedure TForm1.Button2Click(Sender: TObject);
var
i: Integer;
begin
try
// nur lesen öffnen
//open read only
Stream := TFileStream.Create('c:test.dat', fmOpenRead);
except
ShowMessage('Datei konnte nicht geladen werden.');
Exit;
end;
//variable i auf anzahl Einträge setzen
//set variable i to the record count
//Einlesen von TPerson
//Read records TPerson
for i := 2 downto 1 do
begin
Stream.ReadBuffer(Person, SizeOf(TPerson));
Listbox1.Items.Add(Person.vorname + ' ' + Person.Name);
end;
//Einlesen von TComputer
//Read Records TComputer
for i := 2 downto 1 do
begin
Stream.ReadBuffer(Computer, SizeOf(TComputer));
Listbox2.Items.Add(Computer.Name + ' ' + Computer.cpu);
end;
Stream.Free;
end;
Delphi - .....................................
neoturk: ...Use tfilestream ?...
type
TPerson = record
Name: string[50];
vorname: string[50];
end;
TComputer = record
Name: string[30];
cpu: string[30];
end;
var
Form1: TForm1;
Person: TPerson;
Computer: TComputer;
Stream: TFileStream;
implementation
{$R *.DFM}
//Speichern resp. Erstellen von Datei
//Save or create the file
procedure TForm1.Button1Click(Sender: TObject);
begin
try
Stream := TFileStream.Create('c:test.dat', fmOpenReadWrite);
except
Stream := TFileStream.Create('c:test.dat', fmCreate);
end;
//2 Einträge pro Record
//save 2 records for TPerson and TComputer
Person.Name := 'Grossenbacher';
Person.vorname := 'Simon';
Stream.WriteBuffer(Person, SizeOf(TPerson));
Person.Name := 'Stutz';
Person.vorname := 'Thomas';
Stream.WriteBuffer(Person, SizeOf(TPerson));
Computer.Name := 'Delphi';
Computer.cpu := 'Intel';
Stream.WriteBuffer(Computer, SizeOf(TComputer));
Computer.Name := 'Win';
Computer.cpu := 'AMD';
Stream.WriteBuffer(Computer, SizeOf(TComputer));
Stream.Free;
end;
//lädt alle daten von TPerson in listbox1 und
//daten von TComputer in Listbox2
//load records from TPerson to listbox1 and
//load records from TComputer to listbox2
procedure TForm1.Button2Click(Sender: TObject);
var
i: Integer;
begin
try
// nur lesen öffnen
//open read only
Stream := TFileStream.Create('c:test.dat', fmOpenRead);
except
ShowMessage('Datei konnte nicht geladen werden.');
Exit;
end;
//variable i auf anzahl Einträge setzen
//set variable i to the record count
//Einlesen von TPerson
//Read records TPerson
for i := 2 downto 1 do
begin
Stream.ReadBuffer(Person, SizeOf(TPerson));
Listbox1.Items.Add(Person.vorname + ' ' + Person.Name);
end;
//Einlesen von TComputer
//Read Records TComputer
for i := 2 downto 1 do
begin
Stream.ReadBuffer(Computer, SizeOf(TComputer));
Listbox2.Items.Add(Computer.Name + ' ' + Computer.cpu);
end;
Stream.Free;
end;
Delphi - .....................................
neoturk: ...Get the path to program files ?...
uses
Registry;
function GetProgramFilesDir: string;
var
reg: TRegistry;
begin
reg := TRegistry.Create;
try
reg.RootKey := HKEY_LOCAL_MACHINE;
reg.OpenKey('SOFTWAREMicrosoftWindowsCurrentVersion', False);
Result := reg.ReadString('ProgramFilesDir');
finally
reg.Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
// Shows something like c:Program files
// zeigt "c:Programme" (oder ähnlich)
ShowMessage(GetProgramFilesDir);
end;
