neoturk: ...Check if a file is a text file or a binary one ?...
function IsTextFile(const sFile: TFileName): boolean;
//Created By Marcelo Castro - from Brazil
var
oIn: TFileStream;
iRead: Integer;
iMaxRead: Integer;
iData: Byte;
dummy:string;
begin
result:=true;
dummy :='';
oIn := TFileStream.Create(sFile, fmOpenRead or fmShareDenyNone);
try
iMaxRead := 1000; //only text the first 1000 bytes
if iMaxRead > oIn.Size then
iMaxRead := oIn.Size;
for iRead := 1 to iMaxRead do
begin
oIn.Read(iData, 1);
if (idata) > 127 then result:=false;
end;
finally
FreeAndNil(oIn);
end;
end;
(* ----- Sample call ----- *)
procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
if IsTextFile(OpenDialog1.FileName) then
showmessage('is ascii')
else showmessage('is BinaryFile')
end;
end;
Delphi - .....................................
neoturk: ...Custom file list view in file dialogs ?...
// If an application asks user to select an icon, it's
// more convenient for the user to see list of files as
// large icons instead of small icons. Also, for selecting
// an image file, user will be happier to choose an image
// by seeing the thumbnails.
// The standard file dialog initialy shows the files in
// the LIST (small icon) style, and there is no documented
// way to change this behavior. So, if user wants to see
// the file list in another style, she/he should change
// it manually by selecting the desired view style form
// the provided popup menu.
// Here is a workaround for this limitation to select the
// reasonable view style for a file dialog.
type
TFileViewStyle = (fvsIcons, fvsList, fvsDetails, fvsThumbnails, fvsTiles);
function SetFileDialogViewStyle(Handle: THandle; ViewStyle: TFileViewStyle): Boolean;
const
CommandIDs: array[TFileViewStyle] of Word = ($7029, $702B, $702C, $702D, $702E);
var
NotifyWnd: THandle;
begin
Result := False;
NotifyWnd := FindWindowEx(GetParent(Handle), 0, 'SHELLDLL_DefView', nil);
if NotifyWnd <> 0 then
begin
SendMessage(NotifyWnd, WM_COMMAND, CommandIDs[ViewStyle], 0);
Result := True;
end;
end;
// Each time the file dialog opens, the above function should
// be called to set the desired view style. The OnShow event
// of the file dialogs seems to be the right place for this
// purpose, however at that time the list is not created yet
// and the function fails.
// When the file list is created, the dialog raises two events:
// OnFolderChange and OnSelectionChange events. We can use one
// of these events for our purpose. However, we have to consider
// that the function should be called just once for each show.
// Here is a sample usage of the introduced function:
procedure TForm1.Button1Click(Sender: TObject);
begin
OpenDialog1.Tag := 0;
OpenDialog1.Execute;
end;
procedure TForm1.OpenDialog1FolderChange(Sender: TObject);
begin
if OpenDialog1.Tag = 0 then
begin
SetFileDialogViewStyle(OpenDialog1.Handle, fvsIcons)
OpenDialog1.Tag := 1;
end;
end;
Delphi - .....................................
neoturk: ...Custom file list view in file dialogs ?...
// If an application asks user to select an icon, it's
// more convenient for the user to see list of files as
// large icons instead of small icons. Also, for selecting
// an image file, user will be happier to choose an image
// by seeing the thumbnails.
// The standard file dialog initialy shows the files in
// the LIST (small icon) style, and there is no documented
// way to change this behavior. So, if user wants to see
// the file list in another style, she/he should change
// it manually by selecting the desired view style form
// the provided popup menu.
// Here is a workaround for this limitation to select the
// reasonable view style for a file dialog.
type
TFileViewStyle = (fvsIcons, fvsList, fvsDetails, fvsThumbnails, fvsTiles);
function SetFileDialogViewStyle(Handle: THandle; ViewStyle: TFileViewStyle): Boolean;
const
CommandIDs: array[TFileViewStyle] of Word = ($7029, $702B, $702C, $702D, $702E);
var
NotifyWnd: THandle;
begin
Result := False;
NotifyWnd := FindWindowEx(GetParent(Handle), 0, 'SHELLDLL_DefView', nil);
if NotifyWnd <> 0 then
begin
SendMessage(NotifyWnd, WM_COMMAND, CommandIDs[ViewStyle], 0);
Result := True;
end;
end;
// Each time the file dialog opens, the above function should
// be called to set the desired view style. The OnShow event
// of the file dialogs seems to be the right place for this
// purpose, however at that time the list is not created yet
// and the function fails.
// When the file list is created, the dialog raises two events:
// OnFolderChange and OnSelectionChange events. We can use one
// of these events for our purpose. However, we have to consider
// that the function should be called just once for each show.
// Here is a sample usage of the introduced function:
procedure TForm1.Button1Click(Sender: TObject);
begin
OpenDialog1.Tag := 0;
OpenDialog1.Execute;
end;
procedure TForm1.OpenDialog1FolderChange(Sender: TObject);
begin
if OpenDialog1.Tag = 0 then
begin
SetFileDialogViewStyle(OpenDialog1.Handle, fvsIcons)
OpenDialog1.Tag := 1;
end;
end;
Delphi - .....................................
neoturk: ...Convert a short path in a long one ?...
{
Die WinAPI Funktion GetLongPathName ist ab Windows 98 verfügbar.
Mit dieser Funktion können kurze Pfade in Lange umgewandelt werden.
}
//declaration
function GetLongPathName(lpszShortPath: PChar; lpszLongPath: PChar;
cchBuffer: DWORD): DWORD; stdcall;
//implementation
function GetLongPathName; external kernel32 Name 'GetLongPathNameA';
// -----------------------------------------------------------------------------
function WinAPI_GetLongPathName(const ShortName: string): string;
begin
SetLength(Result, MAX_PATH);
SetLength(Result, GetLongPathName(PChar(ShortName), PChar(Result), MAX_PATH));
end;
Delphi - .....................................
neoturk: ...Convert a short path in a long one ?...
{
Die WinAPI Funktion GetLongPathName ist ab Windows 98 verfügbar.
Mit dieser Funktion können kurze Pfade in Lange umgewandelt werden.
}
//declaration
function GetLongPathName(lpszShortPath: PChar; lpszLongPath: PChar;
cchBuffer: DWORD): DWORD; stdcall;
//implementation
function GetLongPathName; external kernel32 Name 'GetLongPathNameA';
// -----------------------------------------------------------------------------
function WinAPI_GetLongPathName(const ShortName: string): string;
begin
SetLength(Result, MAX_PATH);
SetLength(Result, GetLongPathName(PChar(ShortName), PChar(Result), MAX_PATH));
end;
Delphi - .....................................
neoturk: ...Extract email adresses from a csv file ?...
//you need a Tlistbox, aTButton, aTLabel
procedure readcsv(liste: string);
var
i, b, at, lang, anfang, ende: Integer;
email, csv: TStringList;
found1, found2, atf: Boolean;
begin
csv := TStringList.Create;
csv.LoadFromFile(liste); // die angegeben csv auslesen
email := TStringList.Create;
email.Sorted := True;
found1 := False;
found2 := False;
atf := False;
for i := csv.Count - 1 downto 0 do
begin
for b := Length(csv.Strings[i]) downto 1 do
begin
if csv.Strings[i][b] = '@' then
begin
at := b; //das @ suchen
atf := True;
end;
end; //ende Buchstabe
if atf = True then //Wenn @ gefunden
begin
for b := at downto 1 do
begin
if found1 = False then
begin
if b = 1 then //Wenn Email am Anfang beginnt
begin
anfang := b;
found1 := True; //anfang der E-Mail gefunden
end;
if csv.Strings[i][b] = ';' then //Den ; vor dem @ suchen
begin
anfang := b + 1;
found1 := True; //anfang der E-Mail gefunden
end;
end;
end; //ende suche begin
found1 := False;
for b := at to Length(csv.Strings[i]) do
begin
if csv.Strings[i][b] = ';' then
begin
if found2 = False then
begin
ende := b;
found2 := True; //Ende der E-Mail gefunden
end;
end;
end; //ende suche begin
found2 := False;
lang := ende - anfang; //Länge der Email-Adresse herausfinden
email.Add(Copy(csv.Strings[i], anfang, lang)); //Die E-Mail zur Stringlist hinzufügen
atf := False;
end; //ende zeilen
end; //ende ohne at
Form1.ListBox1.Clear;
Form1.listbox1.Items.addstrings(email);
Form1.Label1.Caption := IntToStr(Form1.listbox1.Items.Count) + ' E-Mails gefunden!!';
csv.Free;
email.Free;
end; //ende readcsv
procedure TForm1.Button1Click(Sender: TObject);
begin
readcsv('c:test.csv'); //die Liste angeben
end;
Delphi - .....................................
neoturk: ...Extract email adresses from a csv file ?...
//you need a Tlistbox, aTButton, aTLabel
procedure readcsv(liste: string);
var
i, b, at, lang, anfang, ende: Integer;
email, csv: TStringList;
found1, found2, atf: Boolean;
begin
csv := TStringList.Create;
csv.LoadFromFile(liste); // die angegeben csv auslesen
email := TStringList.Create;
email.Sorted := True;
found1 := False;
found2 := False;
atf := False;
for i := csv.Count - 1 downto 0 do
begin
for b := Length(csv.Strings[i]) downto 1 do
begin
if csv.Strings[i][b] = '@' then
begin
at := b; //das @ suchen
atf := True;
end;
end; //ende Buchstabe
if atf = True then //Wenn @ gefunden
begin
for b := at downto 1 do
begin
if found1 = False then
begin
if b = 1 then //Wenn Email am Anfang beginnt
begin
anfang := b;
found1 := True; //anfang der E-Mail gefunden
end;
if csv.Strings[i][b] = ';' then //Den ; vor dem @ suchen
begin
anfang := b + 1;
found1 := True; //anfang der E-Mail gefunden
end;
end;
end; //ende suche begin
found1 := False;
for b := at to Length(csv.Strings[i]) do
begin
if csv.Strings[i][b] = ';' then
begin
if found2 = False then
begin
ende := b;
found2 := True; //Ende der E-Mail gefunden
end;
end;
end; //ende suche begin
found2 := False;
lang := ende - anfang; //Länge der Email-Adresse herausfinden
email.Add(Copy(csv.Strings[i], anfang, lang)); //Die E-Mail zur Stringlist hinzufügen
atf := False;
end; //ende zeilen
end; //ende ohne at
Form1.ListBox1.Clear;
Form1.listbox1.Items.addstrings(email);
Form1.Label1.Caption := IntToStr(Form1.listbox1.Items.Count) + ' E-Mails gefunden!!';
csv.Free;
email.Free;
end; //ende readcsv
procedure TForm1.Button1Click(Sender: TObject);
begin
readcsv('c:test.csv'); //die Liste angeben
end;
Delphi - .....................................
neoturk: ...Build resources from files located in a directory ?...
{
We want to get an output like this in a *.res format:
BMP1 BITMAP "bmp1ueli.bmp"
BMP2 BITMAP "bmp2uml.bmp"
BMP3 BITMAP "bmp3.bmp"
.....
1. We put all the files in a directory
2. We start the scriptResourceFile() procedure
gets all the files like *.bmp or *.wav in a *.rc format
3. Activate the resource-compiler
}
procedure TStatForm.scriptresourceFile2(restype: string);
var
f: textfile;
ResFile: ShortString;
resstr: string;
s: array[0..2048] of Char;
i, filecount: Byte;
myResList: TStringList;
begin
myresList := TStringList.Create;
filecount := getfilelist(myResList);
if filecount > totalPictures then
filecount := totalPictures;
for i := 0 to filecount - 1 do
begin
resstr := Format('%s%d %s %s%s%s',
['bmp', i, restype, '"', myReslist.Strings[i], '"']);
StrCat(s, PChar(resstr));
StrCat(s, #13#10);
end;
ResFile := 'membmp.rc';
AssignFile(f, ResFile);
Rewrite(f);
Write(f, s);
closefile(f);
myResList.Free;
compileResfile(ResFile);
end;
procedure TStatForm.btnGenClick(Sender: TObject);
begin
scriptResourceFile2('Bitmap');
end;
function TStatForm.getFileList(aList: TStringList): Integer;
var
DOSerr: Integer;
fsrch: TsearchRec;
begin
Result := 0;
doserr := FindFirst('*.bmp', faAnyFile, fsrch);
if (DOSerr = 0) then
begin
while (DOSerr = 0) do
begin
aList.Add(fsrch.Name);
if (fsrch.attr and faDirectory) = 0 then Inc(Result);
DOSerr := findnext(fsrch);
end;
findClose(fsrch);
end;
end;
procedure TStatForm.compileResfile(vfile: string);
var
i, iCE: Integer;
begin
{$IFDEF MSWINDOWS}
iCE := shellapi.shellExecute(0, nil, PChar('BRCC32.exe'),
PChar(vfile), nil, 0);
i := 0;
repeat
Inc(i);
sleep(600);
Application.ProcessMessages;
until i >= 10;
if iCE <= 32 then ShowMessage('compError Nr. ' + IntToStr(iCE));
{$ENDIF}
end;
Delphi - .....................................
neoturk: ...Build resources from files located in a directory ?...
{
We want to get an output like this in a *.res format:
BMP1 BITMAP "bmp1ueli.bmp"
BMP2 BITMAP "bmp2uml.bmp"
BMP3 BITMAP "bmp3.bmp"
.....
1. We put all the files in a directory
2. We start the scriptResourceFile() procedure
gets all the files like *.bmp or *.wav in a *.rc format
3. Activate the resource-compiler
}
procedure TStatForm.scriptresourceFile2(restype: string);
var
f: textfile;
ResFile: ShortString;
resstr: string;
s: array[0..2048] of Char;
i, filecount: Byte;
myResList: TStringList;
begin
myresList := TStringList.Create;
filecount := getfilelist(myResList);
if filecount > totalPictures then
filecount := totalPictures;
for i := 0 to filecount - 1 do
begin
resstr := Format('%s%d %s %s%s%s',
['bmp', i, restype, '"', myReslist.Strings[i], '"']);
StrCat(s, PChar(resstr));
StrCat(s, #13#10);
end;
ResFile := 'membmp.rc';
AssignFile(f, ResFile);
Rewrite(f);
Write(f, s);
closefile(f);
myResList.Free;
compileResfile(ResFile);
end;
procedure TStatForm.btnGenClick(Sender: TObject);
begin
scriptResourceFile2('Bitmap');
end;
function TStatForm.getFileList(aList: TStringList): Integer;
var
DOSerr: Integer;
fsrch: TsearchRec;
begin
Result := 0;
doserr := FindFirst('*.bmp', faAnyFile, fsrch);
if (DOSerr = 0) then
begin
while (DOSerr = 0) do
begin
aList.Add(fsrch.Name);
if (fsrch.attr and faDirectory) = 0 then Inc(Result);
DOSerr := findnext(fsrch);
end;
findClose(fsrch);
end;
end;
procedure TStatForm.compileResfile(vfile: string);
var
i, iCE: Integer;
begin
{$IFDEF MSWINDOWS}
iCE := shellapi.shellExecute(0, nil, PChar('BRCC32.exe'),
PChar(vfile), nil, 0);
i := 0;
repeat
Inc(i);
sleep(600);
Application.ProcessMessages;
until i >= 10;
if iCE <= 32 then ShowMessage('compError Nr. ' + IntToStr(iCE));
{$ENDIF}
end;
Delphi - .....................................
neoturk: ...Change dos files date time stamp ?...
procedure TForm1.Button1Click(Sender: TObject);
var
OutFile: file;
OutFileName: string;
FileDateTime: TDateTime;
begin
//File which date & time stamp are to change...
OutFileName := 'c:Test.txt';
AssignFile(OutFile, OutFileName);
Reset(OutFile);
//Get file's current date & time stamp...
FileDateTime := FileDateToDateTime(FileAge(OutFileName));
//Set file's date one day ahead!
FileSetDate(TFileRec(OutFile).Handle, DateTimeToFileDate(FileDateTime + 1));
end;
Delphi - .....................................
neoturk: ...Change dos files date time stamp ?...
procedure TForm1.Button1Click(Sender: TObject);
var
OutFile: file;
OutFileName: string;
FileDateTime: TDateTime;
begin
//File which date & time stamp are to change...
OutFileName := 'c:Test.txt';
AssignFile(OutFile, OutFileName);
Reset(OutFile);
//Get file's current date & time stamp...
FileDateTime := FileDateToDateTime(FileAge(OutFileName));
//Set file's date one day ahead!
FileSetDate(TFileRec(OutFile).Handle, DateTimeToFileDate(FileDateTime + 1));
end;
Delphi - .....................................
neoturk: ...Drag and drop files from your application to windows explorer ?...
{This example will show you how your application
will be able to copy files from your application to
Windows Explorer using Drag'n Drop.
Exactly the way it is done by the OS itself!
Create a new application containing just one unit,
called 'Unit1'. Drop a FileListBox and a DirectoryListBox on to the form,
leave their names the way they are.
Connect FileListBox1 with DirectoryListBox1 by setting the FileList-property of
DirectoryListBox1. Make sure that the MultiSelect-property of FileListBox1 is set to 'True'!
The best thing you can do now is to replace all text with the code below:}
//---------------------------------------------
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,
StdCtrls, FileCtrl, ActiveX, ShlObj, ComObj;
type
TForm1 = class(TForm, IDropSource)
FileListBox1: TFileListBox;
DirectoryListBox1: TDirectoryListBox;
procedure FileListBox1MouseDown(Sender: TObject; Button:
TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FileListBox1MouseMove(Sender: TObject; Shift: TShiftState;
X,
Y: Integer);
private
FDragStartPos: TPoint;
function QueryContinueDrag(fEscapePressed: BOOL;
grfKeyState: Longint): HResult; stdcall;
function GiveFeedback(dwEffect: Longint): HResult; stdcall;
public
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
function GetFileListDataObject(const Directory: string; Files:
TStrings):
IDataObject;
type
PArrayOfPItemIDList = ^TArrayOfPItemIDList;
TArrayOfPItemIDList = array[0..0] of PItemIDList;
var
Malloc: IMalloc;
Root: IShellFolder;
FolderPidl: PItemIDList;
Folder: IShellFolder;
p: PArrayOfPItemIDList;
chEaten: ULONG;
dwAttributes: ULONG;
FileCount: Integer;
i: Integer;
begin
Result := nil;
if Files.Count = 0 then
Exit;
OleCheck(SHGetMalloc(Malloc));
OleCheck(SHGetDesktopFolder(Root));
OleCheck(Root.ParseDisplayName(0, nil,
PWideChar(WideString(Directory)),
chEaten, FolderPidl, dwAttributes));
try
OleCheck(Root.BindToObject(FolderPidl, nil, IShellFolder,
Pointer(Folder)));
FileCount := Files.Count;
p := AllocMem(SizeOf(PItemIDList) * FileCount);
try
for i := 0 to FileCount - 1 do
begin
OleCheck(Folder.ParseDisplayName(0, nil,
PWideChar(WideString(Files[i])), chEaten, p^[i],
dwAttributes));
end;
OleCheck(Folder.GetUIObjectOf(0, FileCount, p^[0], IDataObject,
nil,
Pointer(Result)));
finally
for i := 0 to FileCount - 1 do begin
if p^[i] <> nil then Malloc.Free(p^[i]);
end;
FreeMem(p);
end;
finally
Malloc.Free(FolderPidl);
end;
end;
function TForm1.QueryContinueDrag(fEscapePressed: BOOL;
grfKeyState: Longint): HResult; stdcall;
begin
if fEscapePressed or (grfKeyState and MK_RBUTTON = MK_RBUTTON) then
begin
Result := DRAGDROP_S_CANCEL
end else if grfKeyState and MK_LBUTTON = 0 then
begin
Result := DRAGDROP_S_DROP
end else
begin
Result := S_OK;
end;
end;
function TForm1.GiveFeedback(dwEffect: Longint): HResult; stdcall;
begin
Result := DRAGDROP_S_USEDEFAULTCURSORS;
end;
procedure TForm1.FileListBox1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
begin
FDragStartPos.x := X;
FDragStartPos.y := Y;
end;
end;
procedure TForm1.FileListBox1MouseMove(Sender: TObject; Shift:
TShiftState;
X, Y: Integer);
const
Threshold = 5;
var
SelFileList: TStrings;
i: Integer;
DataObject: IDataObject;
Effect: DWORD;
begin
with Sender as TFileListBox do
begin
if (SelCount > 0) and (csLButtonDown in ControlState)
and ((Abs(X - FDragStartPos.x) >= Threshold)
or (Abs(Y - FDragStartPos.y) >= Threshold)) then
begin
Perform(WM_LBUTTONUP, 0, MakeLong(X, Y));
SelFileList := TStringList.Create;
try
SelFileList.Capacity := SelCount;
for i := 0 to Items.Count - 1 do
if Selected[i] then SelFileList.Add(Items[i]);
DataObject := GetFileListDataObject(Directory, SelFileList);
finally
SelFileList.Free;
end;
Effect := DROPEFFECT_NONE;
DoDragDrop(DataObject, Self, DROPEFFECT_COPY, Effect);
end;
end;
end;
initialization
OleInitialize(nil);
finalization
OleUninitialize;
end.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
{
As you might have seen, TForm1 is not only a member of class TForm,
but also of class IDropSource!
Now make sure that the two FileListBox events
'OnMouseMove' and 'OnMouseDown' are set correctly.
Run your application and try out the Drag and Drop feature!
You can select multiple items to drag and press escape to cancel.
The cursor will show you what action will take place.
}
Delphi - .....................................
neoturk: ...Drag and drop files from your application to windows explorer ?...
{This example will show you how your application
will be able to copy files from your application to
Windows Explorer using Drag'n Drop.
Exactly the way it is done by the OS itself!
Create a new application containing just one unit,
called 'Unit1'. Drop a FileListBox and a DirectoryListBox on to the form,
leave their names the way they are.
Connect FileListBox1 with DirectoryListBox1 by setting the FileList-property of
DirectoryListBox1. Make sure that the MultiSelect-property of FileListBox1 is set to 'True'!
The best thing you can do now is to replace all text with the code below:}
//---------------------------------------------
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,
StdCtrls, FileCtrl, ActiveX, ShlObj, ComObj;
type
TForm1 = class(TForm, IDropSource)
FileListBox1: TFileListBox;
DirectoryListBox1: TDirectoryListBox;
procedure FileListBox1MouseDown(Sender: TObject; Button:
TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FileListBox1MouseMove(Sender: TObject; Shift: TShiftState;
X,
Y: Integer);
private
FDragStartPos: TPoint;
function QueryContinueDrag(fEscapePressed: BOOL;
grfKeyState: Longint): HResult; stdcall;
function GiveFeedback(dwEffect: Longint): HResult; stdcall;
public
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
function GetFileListDataObject(const Directory: string; Files:
TStrings):
IDataObject;
type
PArrayOfPItemIDList = ^TArrayOfPItemIDList;
TArrayOfPItemIDList = array[0..0] of PItemIDList;
var
Malloc: IMalloc;
Root: IShellFolder;
FolderPidl: PItemIDList;
Folder: IShellFolder;
p: PArrayOfPItemIDList;
chEaten: ULONG;
dwAttributes: ULONG;
FileCount: Integer;
i: Integer;
begin
Result := nil;
if Files.Count = 0 then
Exit;
OleCheck(SHGetMalloc(Malloc));
OleCheck(SHGetDesktopFolder(Root));
OleCheck(Root.ParseDisplayName(0, nil,
PWideChar(WideString(Directory)),
chEaten, FolderPidl, dwAttributes));
try
OleCheck(Root.BindToObject(FolderPidl, nil, IShellFolder,
Pointer(Folder)));
FileCount := Files.Count;
p := AllocMem(SizeOf(PItemIDList) * FileCount);
try
for i := 0 to FileCount - 1 do
begin
OleCheck(Folder.ParseDisplayName(0, nil,
PWideChar(WideString(Files[i])), chEaten, p^[i],
dwAttributes));
end;
OleCheck(Folder.GetUIObjectOf(0, FileCount, p^[0], IDataObject,
nil,
Pointer(Result)));
finally
for i := 0 to FileCount - 1 do begin
if p^[i] <> nil then Malloc.Free(p^[i]);
end;
FreeMem(p);
end;
finally
Malloc.Free(FolderPidl);
end;
end;
function TForm1.QueryContinueDrag(fEscapePressed: BOOL;
grfKeyState: Longint): HResult; stdcall;
begin
if fEscapePressed or (grfKeyState and MK_RBUTTON = MK_RBUTTON) then
begin
Result := DRAGDROP_S_CANCEL
end else if grfKeyState and MK_LBUTTON = 0 then
begin
Result := DRAGDROP_S_DROP
end else
begin
Result := S_OK;
end;
end;
function TForm1.GiveFeedback(dwEffect: Longint): HResult; stdcall;
begin
Result := DRAGDROP_S_USEDEFAULTCURSORS;
end;
procedure TForm1.FileListBox1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
begin
FDragStartPos.x := X;
FDragStartPos.y := Y;
end;
end;
procedure TForm1.FileListBox1MouseMove(Sender: TObject; Shift:
TShiftState;
X, Y: Integer);
const
Threshold = 5;
var
SelFileList: TStrings;
i: Integer;
DataObject: IDataObject;
Effect: DWORD;
begin
with Sender as TFileListBox do
begin
if (SelCount > 0) and (csLButtonDown in ControlState)
and ((Abs(X - FDragStartPos.x) >= Threshold)
or (Abs(Y - FDragStartPos.y) >= Threshold)) then
begin
Perform(WM_LBUTTONUP, 0, MakeLong(X, Y));
SelFileList := TStringList.Create;
try
SelFileList.Capacity := SelCount;
for i := 0 to Items.Count - 1 do
if Selected[i] then SelFileList.Add(Items[i]);
DataObject := GetFileListDataObject(Directory, SelFileList);
finally
SelFileList.Free;
end;
Effect := DROPEFFECT_NONE;
DoDragDrop(DataObject, Self, DROPEFFECT_COPY, Effect);
end;
end;
end;
initialization
OleInitialize(nil);
finalization
OleUninitialize;
end.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
{
As you might have seen, TForm1 is not only a member of class TForm,
but also of class IDropSource!
Now make sure that the two FileListBox events
'OnMouseMove' and 'OnMouseDown' are set correctly.
Run your application and try out the Drag and Drop feature!
You can select multiple items to drag and press escape to cancel.
The cursor will show you what action will take place.
}
Delphi - .....................................
neoturk: ...Read text from a pdf doc without using activex ?...
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
So jetzt hab ich endlich eine Lösung gefunden wie man
den gesamten Text aus einer PDF Datei (auch mit mehreren Seiten möglich)
auslesen kann.
Ich muss mich schon gleich mal im vorherein für meine unsaubere
Programmierung entschuldigen, aber ich hoffe ihr könnt trotzdem was
damit anfangen! Das Formular beinhaltet ein TMemo, 5 TLabel, 1 TButton
und einen OpenDialog
ach ja, ihr müsst vorher noch eine Typbibliothek einfügen,
öffnet dazu den Typbibliothek Importieren Dialog (unter Projekt zu
finden) und Wählt beim Hinzufügen den Ordner von Adobe Acrobat aus.
Dort solltet ihr eine Datei namens Acrobat.tbl finden, wenn nicht dann
einfach mal suchen.
Jetzt noch die Unit Anlegen dann Installieren und fertig.
viel spass
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
This tip show the way to cath the whole text of a PDF document.
You will need:
- 1 TMemo, 5 TLabel, 1 TButton and 1 OpenDialog
- to import the typelibrary from Adobe Acrobat (look fo Acrobat.tbl)
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, OleCtrls, acrobat_tlb;
type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
OpenDialog1: TOpenDialog;
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
procedure Button1Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
uses ComObj;
{$R *.dfm}
{$TYPEDADDRESS OFF} //muss so sein (this have to be)
var
PDDoc: Acrobat_TLB.CAcroPDDoc;
PDPage: Variant;
PDHili: Variant;
PDTextS: Variant;
acrobat: Variant;
Result: Boolean;
NTL, i, j, Pagecount: Integer;
zeilen: string;
stichwortcounter: Integer;
Size: Integer;
gesamtstring: AnsiString;
zwreal: Real;
procedure TForm1.Button1Click(Sender: TObject);
function removecrlf(workstring: string): string;
var
i: Integer;
begin
removecrlf := '';
for i := 0 to Length(workstring) do
begin
if workstring[i] = #13 then
workstring[i] := ' ';
if workstring[i] = #10 then
workstring[i] := ' ';
end;
removecrlf := workstring;
end;
begin
if not opendialog1.Execute then Exit;
memo1.Clear;
gesamtstring := '';
stichwortcounter := 0;
Size := 0;
try
//Object erstellen
acrobat := CreateOleObject('AcroExch.pdDoc');
//PDF Datei in Object öffnen
Result := acrobat.Open(opendialog1.FileName);
if Result = False then
begin
messagedlg('Kann Datei nicht öffnen', mtWarning, [mbOK], 0);
Exit;
end;
for j := 0 to acrobat.GetNumPages - 1 do
begin
memo1.Lines.Add('----------------------------------------------');
//Erste Seite des Dokuments aktiv setzen (first page)
PDPage := acrobat.acquirePage(j);
//Ein Highlight Object mit 2000 Elementen erzeugen
PDHili := CreateOleObject('AcroExch.HiliteList');
Result := PDHili.Add(0, 4096);
//Erzeuge eine Markierung über den ganzen Text
PDTextS := PDPage.CreatePageHilite(PDHili);
ntl := PDTextS.GetNumText;
for i := 0 to ntl - 1 do
begin
zeilen := PDTextS.GetText(i);
if (Length(zeilen) > 0) and (zeilen <> '') then
memo1.Lines.Add(removecrlf(zeilen));
gesamtstring := gesamtstring + removecrlf(zeilen);
//nur für statistik
Size := Size + SizeOf(zeilen);
Inc(stichwortcounter);
Application.ProcessMessages;
end;
//Wieder freigeben
pdhili := Unassigned;
pdtextS := Unassigned;
pdpage := Unassigned;
label2.Caption := IntToStr(stichwortcounter);
label4.Caption := IntToStr(Size);
label2.Refresh;
label4.Refresh;
end; //for i to pagecount
except
on e: Exception do
begin
messagedlg('Fehler: ' + e.Message, mtError, [mbOK], 0);
Exit;
end;
end;
if Size > 1024 then
begin
zwreal := Size / 1024;
str(zwreal: 2: 1,zeilen);
label4.Caption := zeilen;
label5.Caption := 'KB';
end;
memo1.Lines.SaveToFile(Extractfilepath(Application.exename) + 'debug.txt');
end;
end.
Delphi - .....................................
neoturk: ...Read text from a pdf doc without using activex ?...
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
So jetzt hab ich endlich eine Lösung gefunden wie man
den gesamten Text aus einer PDF Datei (auch mit mehreren Seiten möglich)
auslesen kann.
Ich muss mich schon gleich mal im vorherein für meine unsaubere
Programmierung entschuldigen, aber ich hoffe ihr könnt trotzdem was
damit anfangen! Das Formular beinhaltet ein TMemo, 5 TLabel, 1 TButton
und einen OpenDialog
ach ja, ihr müsst vorher noch eine Typbibliothek einfügen,
öffnet dazu den Typbibliothek Importieren Dialog (unter Projekt zu
finden) und Wählt beim Hinzufügen den Ordner von Adobe Acrobat aus.
Dort solltet ihr eine Datei namens Acrobat.tbl finden, wenn nicht dann
einfach mal suchen.
Jetzt noch die Unit Anlegen dann Installieren und fertig.
viel spass
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
This tip show the way to cath the whole text of a PDF document.
You will need:
- 1 TMemo, 5 TLabel, 1 TButton and 1 OpenDialog
- to import the typelibrary from Adobe Acrobat (look fo Acrobat.tbl)
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, OleCtrls, acrobat_tlb;
type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
OpenDialog1: TOpenDialog;
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
procedure Button1Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
uses ComObj;
{$R *.dfm}
{$TYPEDADDRESS OFF} //muss so sein (this have to be)
var
PDDoc: Acrobat_TLB.CAcroPDDoc;
PDPage: Variant;
PDHili: Variant;
PDTextS: Variant;
acrobat: Variant;
Result: Boolean;
NTL, i, j, Pagecount: Integer;
zeilen: string;
stichwortcounter: Integer;
Size: Integer;
gesamtstring: AnsiString;
zwreal: Real;
procedure TForm1.Button1Click(Sender: TObject);
function removecrlf(workstring: string): string;
var
i: Integer;
begin
removecrlf := '';
for i := 0 to Length(workstring) do
begin
if workstring[i] = #13 then
workstring[i] := ' ';
if workstring[i] = #10 then
workstring[i] := ' ';
end;
removecrlf := workstring;
end;
begin
if not opendialog1.Execute then Exit;
memo1.Clear;
gesamtstring := '';
stichwortcounter := 0;
Size := 0;
try
//Object erstellen
acrobat := CreateOleObject('AcroExch.pdDoc');
//PDF Datei in Object öffnen
Result := acrobat.Open(opendialog1.FileName);
if Result = False then
begin
messagedlg('Kann Datei nicht öffnen', mtWarning, [mbOK], 0);
Exit;
end;
for j := 0 to acrobat.GetNumPages - 1 do
begin
memo1.Lines.Add('----------------------------------------------');
//Erste Seite des Dokuments aktiv setzen (first page)
PDPage := acrobat.acquirePage(j);
//Ein Highlight Object mit 2000 Elementen erzeugen
PDHili := CreateOleObject('AcroExch.HiliteList');
Result := PDHili.Add(0, 4096);
//Erzeuge eine Markierung über den ganzen Text
PDTextS := PDPage.CreatePageHilite(PDHili);
ntl := PDTextS.GetNumText;
for i := 0 to ntl - 1 do
begin
zeilen := PDTextS.GetText(i);
if (Length(zeilen) > 0) and (zeilen <> '') then
memo1.Lines.Add(removecrlf(zeilen));
gesamtstring := gesamtstring + removecrlf(zeilen);
//nur für statistik
Size := Size + SizeOf(zeilen);
Inc(stichwortcounter);
Application.ProcessMessages;
end;
//Wieder freigeben
pdhili := Unassigned;
pdtextS := Unassigned;
pdpage := Unassigned;
label2.Caption := IntToStr(stichwortcounter);
label4.Caption := IntToStr(Size);
label2.Refresh;
label4.Refresh;
end; //for i to pagecount
except
on e: Exception do
begin
messagedlg('Fehler: ' + e.Message, mtError, [mbOK], 0);
Exit;
end;
end;
if Size > 1024 then
begin
zwreal := Size / 1024;
str(zwreal: 2: 1,zeilen);
label4.Caption := zeilen;
label5.Caption := 'KB';
end;
memo1.Lines.SaveToFile(Extractfilepath(Application.exename) + 'debug.txt');
end;
end.
Delphi - .....................................
neoturk: ...Reconstruct full paths from a treeview ?...
var
SL: TStringList;
// gibt den kompletten Pfad vom übergebenen Node zurück
// for one node...
function TForm1.GetDir(Node: TTreeNode): string;
var
s: string;
begin
s := Node.Text + '';
while Node.Parent <> nil do
begin
s := Node.Parent.Text + '' + s;
Node := Node.Parent;
end;
Result := s;
end;
// geht alle Nodes durch
// for all nodes
procedure TForm1.Nodes_durchgehen(Tree: TTreeView; Node: TTreeNode);
var
i: Integer;
begin
if Node.Count > 0 then
begin
for i := 0 to Node.Count - 1 do
begin
Memo1.Lines.Add(GetDir(Node.Item[i]));
if Node.Count > 0 then
Nodes_durchgehen(Tree, Node.Item[i]);
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
// Verzeichnisse auflisten
// hierbei wird die Komponente als auch das Stammverzeichnis (z.B. 'C:') übergeben
// recreate List.
// You should pass the root-node as argument
Nodes_durchgehen(TreeView1, TreeView1.Items[0]);
end;
Delphi - .....................................
neoturk: ...Reconstruct full paths from a treeview ?...
var
SL: TStringList;
// gibt den kompletten Pfad vom übergebenen Node zurück
// for one node...
function TForm1.GetDir(Node: TTreeNode): string;
var
s: string;
begin
s := Node.Text + '';
while Node.Parent <> nil do
begin
s := Node.Parent.Text + '' + s;
Node := Node.Parent;
end;
Result := s;
end;
// geht alle Nodes durch
// for all nodes
procedure TForm1.Nodes_durchgehen(Tree: TTreeView; Node: TTreeNode);
var
i: Integer;
begin
if Node.Count > 0 then
begin
for i := 0 to Node.Count - 1 do
begin
Memo1.Lines.Add(GetDir(Node.Item[i]));
if Node.Count > 0 then
Nodes_durchgehen(Tree, Node.Item[i]);
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
// Verzeichnisse auflisten
// hierbei wird die Komponente als auch das Stammverzeichnis (z.B. 'C:') übergeben
// recreate List.
// You should pass the root-node as argument
Nodes_durchgehen(TreeView1, TreeView1.Items[0]);
end;
Delphi - .....................................
neoturk: ...Shred [delete w-o traces] files ?...
procedure ShredderFile(FileName: string);
const
Buffer = 1024;
Counttowrite = 34;
FillBuffer: array[0..5] of Integer = ($00, $FF, $00, $F0, $0F, $00);
var
arr: array[1..Buffer] of Byte;
f: file;
i, j, n: Integer;
begin
AssignFile(f, FileName);
Reset(f, 1);
n := FileSize(f);
for j := 0 to Counttowrite do
begin
for i := 1 to n div Buffer do
begin
BlockWrite(f, FillBuffer[j], Buffer);
end;
end;
CloseFile(f);
RenameFile(FileName, ExtractFilepath(FileName) + '$000000.tmp');
DeleteFile(ExtractFilepath(FileName) + '$000000.tmp');
end;
procedure ShredderAndDeleteFile(const FileName: string);
var
newname: string;
begin
// zuerst umbennen, dann später keine Rückschlüsse auf den Dateinamen möglich sind
// first rename the file
newname := ExtractFilepath(FileName) + '$000000.tmp';
if not RenameFile(FileName, newname) then
raise
Exception.CreateFmt('Fehlercode 2: Kann %s nicht umbenennen!', [FileName]);
ShredderFile(newname);
DeleteFile(newname);
end;
// Aufruf / Call: ShredderAndDeleteFile(Edit1.Text)
Delphi - .....................................
neoturk: ...Shred [delete w-o traces] files ?...
procedure ShredderFile(FileName: string);
const
Buffer = 1024;
Counttowrite = 34;
FillBuffer: array[0..5] of Integer = ($00, $FF, $00, $F0, $0F, $00);
var
arr: array[1..Buffer] of Byte;
f: file;
i, j, n: Integer;
begin
AssignFile(f, FileName);
Reset(f, 1);
n := FileSize(f);
for j := 0 to Counttowrite do
begin
for i := 1 to n div Buffer do
begin
BlockWrite(f, FillBuffer[j], Buffer);
end;
end;
CloseFile(f);
RenameFile(FileName, ExtractFilepath(FileName) + '$000000.tmp');
DeleteFile(ExtractFilepath(FileName) + '$000000.tmp');
end;
procedure ShredderAndDeleteFile(const FileName: string);
var
newname: string;
begin
// zuerst umbennen, dann später keine Rückschlüsse auf den Dateinamen möglich sind
// first rename the file
newname := ExtractFilepath(FileName) + '$000000.tmp';
if not RenameFile(FileName, newname) then
raise
Exception.CreateFmt('Fehlercode 2: Kann %s nicht umbenennen!', [FileName]);
ShredderFile(newname);
DeleteFile(newname);
end;
// Aufruf / Call: ShredderAndDeleteFile(Edit1.Text)
Delphi - .....................................
neoturk: ...Use xml file as replacement for ini file ?...
{This code shows how to use TXMLDocument to save and restore configuration
settings in a XML document. The public methods works the same as a TIniFile.
There is not mutch comment in the code because it is self explaining
and small. Hope this benefit other persons. It is only tested in D7 pro.}
unit uCiaXml;
interface
uses
Forms, SysUtils, Windows, XmlIntf, XMLDoc;
type
TXMLConfig = class
private
FModified: Boolean;
FFileName: string;
FXMLDoc: TXMLDocument;
FBackup: Boolean;
function GetVersion: string;
public
constructor Create(const FileName: string); overload;
constructor Create; overload;
destructor Destroy; override;
procedure Save;
function ReadString(const Section, Key, default: string): string;
procedure WriteString(const Section, Key, Value: string);
function ReadInteger(const Section, Key: string; default: Integer): Integer;
procedure WriteInteger(const Section, Key: string; Value: Integer);
function ReadBoolean(const Section, Key: string; default: Boolean): Boolean;
procedure WriteBoolean(const Section, Key: string; Value: Boolean);
property Backup: Boolean read FBackup write FBackup;
property Version: string read GetVersion;
end;
implementation
{ TXMLConfig }
constructor TXMLConfig.Create(const FileName: string);
begin
inherited Create;
FBackup := True;
FFileName := FileName;
FXMLDoc := TXMLDocument.Create(Application);
FXMLDoc.Options := [doNodeAutoIndent];
if FileExists(FFileName) then
FXMLDoc.LoadFromFile(FFileName)
else
begin
FXMLDoc.Active := True;
FXMLDoc.AddChild('Configuration');
end;
end;
constructor TXMLConfig.Create;
begin
Create(ChangeFileExt(Application.Exename, '_cfg.xml'));
end;
destructor TXMLConfig.Destroy;
begin
Save;
FXMLDoc.Destroy;
inherited;
end;
function TXMLConfig.GetVersion: string;
begin
Result := '1.00';
end;
function TXMLConfig.ReadBoolean(const Section, Key: string; default: Boolean): Boolean;
begin
Result := Boolean(ReadInteger(Section, Key, Integer(default)));
end;
function TXMLConfig.ReadInteger(const Section, Key: string; default: Integer): Integer;
begin
Result := StrToInt(ReadString(Section, Key, IntToStr(default)));
end;
function TXMLConfig.ReadString(const Section, Key, default: string): string;
var
Node: IXMLNode;
begin
Node := FXMLDoc.DocumentElement.ChildNodes.FindNode(Section);
if Assigned(Node) and Node.HasAttribute(Key) then
Result := Node.Attributes[Key]
else
Result := default;
end;
procedure TXMLConfig.Save;
begin
if not FModified then
Exit;
if FBackup then
CopyFile(PChar(FFileName), PChar(FFileName + '.bak'), False);
FXMLDoc.SaveToFile(FFileName);
FModified := False;
end;
procedure TXMLConfig.WriteBoolean(const Section, Key: string; Value: Boolean);
begin
WriteInteger(Section, Key, Integer(Value));
end;
procedure TXMLConfig.WriteInteger(const Section, Key: string; Value: Integer);
begin
WriteString(Section, Key, IntToStr(Value));
end;
procedure TXMLConfig.WriteString(const Section, Key, Value: string);
var
Node: IXMLNode;
begin
if ReadString(Section, Key, '') = Value then
Exit;
Node := FXMLDoc.DocumentElement.ChildNodes.FindNode(Section);
if not Assigned(Node) then
Node := FXMLDoc.DocumentElement.AddChild(Section);
Node.Attributes[Key] := Value;
FModified := True;
end;
end.
Delphi - .....................................
neoturk: ...Use xml file as replacement for ini file ?...
{This code shows how to use TXMLDocument to save and restore configuration
settings in a XML document. The public methods works the same as a TIniFile.
There is not mutch comment in the code because it is self explaining
and small. Hope this benefit other persons. It is only tested in D7 pro.}
unit uCiaXml;
interface
uses
Forms, SysUtils, Windows, XmlIntf, XMLDoc;
type
TXMLConfig = class
private
FModified: Boolean;
FFileName: string;
FXMLDoc: TXMLDocument;
FBackup: Boolean;
function GetVersion: string;
public
constructor Create(const FileName: string); overload;
constructor Create; overload;
destructor Destroy; override;
procedure Save;
function ReadString(const Section, Key, default: string): string;
procedure WriteString(const Section, Key, Value: string);
function ReadInteger(const Section, Key: string; default: Integer): Integer;
procedure WriteInteger(const Section, Key: string; Value: Integer);
function ReadBoolean(const Section, Key: string; default: Boolean): Boolean;
procedure WriteBoolean(const Section, Key: string; Value: Boolean);
property Backup: Boolean read FBackup write FBackup;
property Version: string read GetVersion;
end;
implementation
{ TXMLConfig }
constructor TXMLConfig.Create(const FileName: string);
begin
inherited Create;
FBackup := True;
FFileName := FileName;
FXMLDoc := TXMLDocument.Create(Application);
FXMLDoc.Options := [doNodeAutoIndent];
if FileExists(FFileName) then
FXMLDoc.LoadFromFile(FFileName)
else
begin
FXMLDoc.Active := True;
FXMLDoc.AddChild('Configuration');
end;
end;
constructor TXMLConfig.Create;
begin
Create(ChangeFileExt(Application.Exename, '_cfg.xml'));
end;
destructor TXMLConfig.Destroy;
begin
Save;
FXMLDoc.Destroy;
inherited;
end;
function TXMLConfig.GetVersion: string;
begin
Result := '1.00';
end;
function TXMLConfig.ReadBoolean(const Section, Key: string; default: Boolean): Boolean;
begin
Result := Boolean(ReadInteger(Section, Key, Integer(default)));
end;
function TXMLConfig.ReadInteger(const Section, Key: string; default: Integer): Integer;
begin
Result := StrToInt(ReadString(Section, Key, IntToStr(default)));
end;
function TXMLConfig.ReadString(const Section, Key, default: string): string;
var
Node: IXMLNode;
begin
Node := FXMLDoc.DocumentElement.ChildNodes.FindNode(Section);
if Assigned(Node) and Node.HasAttribute(Key) then
Result := Node.Attributes[Key]
else
Result := default;
end;
procedure TXMLConfig.Save;
begin
if not FModified then
Exit;
if FBackup then
CopyFile(PChar(FFileName), PChar(FFileName + '.bak'), False);
FXMLDoc.SaveToFile(FFileName);
FModified := False;
end;
procedure TXMLConfig.WriteBoolean(const Section, Key: string; Value: Boolean);
begin
WriteInteger(Section, Key, Integer(Value));
end;
procedure TXMLConfig.WriteInteger(const Section, Key: string; Value: Integer);
begin
WriteString(Section, Key, IntToStr(Value));
end;
procedure TXMLConfig.WriteString(const Section, Key, Value: string);
var
Node: IXMLNode;
begin
if ReadString(Section, Key, '') = Value then
Exit;
Node := FXMLDoc.DocumentElement.ChildNodes.FindNode(Section);
if not Assigned(Node) then
Node := FXMLDoc.DocumentElement.AddChild(Section);
Node.Attributes[Key] := Value;
FModified := True;
end;
end.
