poniżej zamieszczam fragment kodu
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ActiveX, ShlObj, Clipbrd;
type
TForm5 = class(TForm)
Panel1: TPanel;
Button1: TButton;
ListBox1: TListBox;
Button2: TButton;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form5: TForm5;
implementation
{$R *.dfm}
procedure ListBoxToClipboard(ListBox: TListBox;
BufferSize: Integer;
CopyAll: Boolean);
var
Buffer: PChar;
Size: Integer;
Ptr: PChar;
I: Integer;
Line: string[255];
Count: Integer;
begin
if not Assigned(ListBox) then
Exit;
GetMem(Buffer, BufferSize);
Ptr := Buffer;
Count := 0;
for I := 0 to ListBox.Items.Count - 1 do
begin
Line := ListBox.Items.strings[I];
if not CopyAll and ListBox.MultiSelect and (not ListBox.Selected[I]) then
Continue;
{ Check buffer overflow }
Count := Count + Length(Line) + 3;
if Count = BufferSize then
Break;
{ Append to buffer }
Move(Line[1], Ptr^, Length(Line));
Ptr := Ptr + Length(Line);
Ptr[0] := #13;
Ptr[1] := #10;
Ptr := Ptr + 2;
end;
Ptr[0] := #0;
ClipBoard.SetTextBuf(Buffer);
FreeMem(Buffer, BufferSize);
end;
procedure ClipboardToListBox(ListBox: TListbox);
begin
if not Assigned(ListBox) then
Exit;
if not Clipboard.HasFormat(CF_TEXT) then
Exit;
Listbox.Items.Text := Clipboard.AsText;
end;
function GetIEFavourites(const favpath: string): TStrings;
var
searchrec: TSearchRec;
str: TStrings;
path, dir, FileName: string;
Buffer: array[0..2047] of Char;
found: Integer;
begin
str := TStringList.Create;
// Get all file names in the favourites path
path := FavPath + '\*.url';
dir := ExtractFilepath(path);
found := FindFirst(path, faAnyFile, searchrec);
while found = 0 do
begin
// Get now URLs from files in variable files
Setstring(FileName, Buffer, GetPrivateProfilestring('InternetShortcut',
PChar('URL'), nil, Buffer, SizeOf(Buffer), PChar(dir + searchrec.Name)));
str.Add(FileName);
found := FindNext(searchrec);
end;
// find Subfolders
found := FindFirst(dir + '\*.*', faAnyFile, searchrec);
while found = 0 do
begin
if ((searchrec.Attr and faDirectory) > 0) and (searchrec.Name[1] <> '.') then
str.Addstrings(GetIEFavourites(dir + '' + searchrec.Name));
found := FindNext(searchrec);
end;
FindClose(searchrec);
Result := str;
end;
procedure FreePidl(pidl: PItemIDList);
var
allocator: IMalloc;
begin
if Succeeded(SHGetMalloc(allocator)) then
begin
allocator.Free(pidl);
{$IFDEF VER100}
allocator.Release;
{$ENDIF}
end;
end;
procedure TForm5.Button1Click(Sender: TObject);
var
pidl: PItemIDList;
FavPath: array[0..MAX_PATH] of Char;
begin
if Succeeded(ShGetSpecialFolderLocation(Handle, CSIDL_FAVORITES, pidl)) then
begin
if ShGetPathfromIDList(pidl, FavPath) then
ListBox1.Items := GetIEFavourites(StrPas(FavPath));
FreePIDL(pidl);
end;
end;
procedure TForm5.Button3Click(Sender: TObject);
begin
close;
end;
procedure TForm5.Button2Click(Sender: TObject);
begin
ListBoxToClipboard(Listbox1,1024,False);
end;
end.
Problem polega natym, że przy dodawniu tekstu do schowka ( Button2) wyskauje mi seria błędów. Przeglądałem kod doładnie i niemoge znaleźć błędu. Byłbym wdzięczny za pomoc