1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:

uses 
  ShellApi;

function TfrmMain.doppelt(str: String; ListView: TListView): Boolean;
var
  i: Integer;
begin                    // prüft ob doppelte Einträge vorhanden sind
  Result := False;
  for i := 0 to ListView.Items.Count - 1 do
    if ListView.Items[i].Caption = Str then
    begin
      Result := True;
      exit;
    end;
end;

procedure TfrmMain.ListView1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  accept := Source is TShellListView;
end;

procedure TfrmMain.ListView1DragDrop(Sender, Source: TObject; X, Y: Integer);
var
  i: Integer;
  Icon: TIcon;           
  FileInfo: SHFILEINFO;  
  ListItem: TListItem;   
begin
  Icon := TIcon.Create;       
  ListView1.Items.BeginUpdate;  
  try
    if (Sender is TListView) and (Source is TShellListView) then
    begin
      with Sender as TListView do
      begin
        for i := 0 to ShellListView1.Items.Count - 1 do
          if (ShellListView1.Items.Item[i].Selected) and
          (not doppelt(ShellListView1.Folders[i].PathName, ListView1)) then
          begin
            ListItem := ListView1.Items.Add;                          
            Listitem.Caption := ShellListView1.Folders[i].PathName;
            SHGetFileInfo(PChar(ShellListView1.Folders[i].PathName), 0, FileInfo, //*
                  SizeOf(FileInfo), SHGFI_ICON or SHGFI_SMALLICON);     
            icon.Handle := FileInfo.hIcon;                               
            ListItem.ImageIndex := ImageList1.AddIcon(Icon);             
          end;
      end;
    end;
  finally
    Icon.Free;                    
    ListView1.Items.EndUpdate;      
  end;  
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:

function GetTreeViewText(hTVwnd: HWND; memo1, memo2: TMemo): pchar;
const
  MAX_TEXT = 256;
type
  TVITEM = TTVITEM;
var
  lpBuf: array[0..MAX_TEXT - 1] of char;
  tvi: TVITEM;

  dwPId: DWORD;
  hProc: THANDLE;
  pText, pAddr: pointer;
  dwTmp: DWORD;
  i, i2, nCount, size: integer;
  chan: integer;
  is_chan: boolean;
//  ret, ret_usr, res: TStringList;
begin
// Get ThreadID and ProzessID
  if BOOL(GetWindowThreadProcessId(hTVwnd, @dwPId)) then
// Get a handle to the process with the needed access
    hProc := OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ or PROCESS_VM_WRITE, FALSE, dwPId);
  if hProc <> 0 then
  begin
// Allocate memory for thet text to hold in the target process ...
    pText := VirtualAllocEx(hProc, nil, MAX_TEXT, MEM_RESERVE or MEM_COMMIT, PAGE_READWRITE);
// Allocate memory for the TVITEM structure in target process ...
    pAddr := VirtualAllocEx(hProc, nil, sizeof(tvi), MEM_RESERVE or MEM_COMMIT, PAGE_READWRITE);
// Get number of nodes in the target treeview ...
    nCount := SendMessage(hTVwnd, TVM_GETCOUNT, 0, 0);
// We want the text only ... set some flags in structure
    tvi.mask := TVIF_TEXT;
    tvi.pszText := pText;
    tvi.cchTextMax := MAX_TEXT - 1;

// Get root item handle ...
    tvi.hItem := HTREEITEM(SendMessage(hTVwnd, TVM_GETNEXTITEM, TVGN_ROOT, 0));
// Iterate through the whole treeview and collapse all root child items
// (to avoid flickering and stuff)
    for i := 0 to nCount - 1 do
    begin
// Write our structure (with flags) to the process
      if WriteProcessMemory(hProc, pAddr, @tvi, sizeof(tvi), dwTmp) and
// Get the stuff we need back
      (SendMessage(hTVwnd, TVM_GETITEM, 0, Integer(pAddr)) <> 0) and
// Read the text from the pointer we got ... respect MAX_TEXT
      ReadProcessMemory(hProc, pText, @lpBuf, MAX_TEXT, dwTmp) then
      begin
// If successful and not root item, collapse it.
        if (i > 0) then
// Collapse the item ... next visible item will be a child item of the root, too
          SendMessage(hTVwnd, TVM_EXPAND, TVE_COLLAPSE, Integer(tvi.hItem));
// Get handle to next visible item ...
        tvi.hItem := HTREEITEM(SendMessage(hTVwnd, TVM_GETNEXTITEM, TVGN_NEXTVISIBLE, Integer(tvi.hItem)));
// Break here if we face the last visible item ...
        if tvi.hItem = HTREEITEM(0) then break;
      end
// If not successful break here ...
      else
        break;
    end;
// Get root item again
    tvi.hItem := HTREEITEM(SendMessage(hTVwnd, TVM_GETNEXTITEM, TVGN_ROOT, 0));
// ...  and iterate through the treeview once more ...
    for i := 0 to (nCount - 1) do
    begin
// Write our structure (with flags) to the process
      if WriteProcessMemory(hProc, pAddr, @tvi, sizeof(TV_ITEM), dwTmp) and
// Get the stuff we need back
      (SendMessage(hTVwnd, TVM_GETITEM, 0, Integer(pAddr)) <> 0) and
// Read the text from the pointer we got ... respect MAX_TEXT
      ReadProcessMemory(hProc, pText, @lpBuf, MAX_TEXT, dwTmp) then
      begin
// If successful and not root item, get text ...
        if (i > 0) then
          memo1.Lines.Append(string(lpBuf));
// Get handle to next visible item ...
        tvi.hItem := HTREEITEM(SendMessage(hTVwnd, TVM_GETNEXTITEM, TVGN_NEXTVISIBLE, Integer(tvi.hItem)));
      end else break;
    end;
// Get root item again
    tvi.hItem := HTREEITEM(SendMessage(hTVwnd, TVM_GETNEXTITEM, TVGN_ROOT, 0));
// ...  and iterate through the treeview once more ...
    for i := 0 to (nCount - 1) do
    begin
      if WriteProcessMemory(hProc, pAddr, @tvi, sizeof(TV_ITEM), dwTmp) and
        (SendMessage(hTVwnd, TVM_GETITEM, 0, Integer(pAddr)) <> 0) and
        ReadProcessMemory(hProc, pText, @lpBuf, MAX_TEXT, dwTmp) then
      begin
        if (i > 0) then SendMessage(hTVwnd, TVM_EXPAND, TVE_EXPAND, Integer(tvi.hItem));
        tvi.hItem := HTREEITEM(SendMessage(hTVwnd, TVM_GETNEXTITEM, TVGN_NEXTVISIBLE, Integer(tvi.hItem)));
      end else break;
    end;
    tvi.hItem := HTREEITEM(SendMessage(hTVwnd, TVM_GETNEXTITEM, TVGN_ROOT, 0));
    for i := 0 to (nCount - 1) do
    begin
      if WriteProcessMemory(hProc, pAddr, @tvi, sizeof(TV_ITEM), dwTmp) and
        (SendMessage(hTVwnd, TVM_GETITEM, 0, Integer(pAddr)) <> 0) and
        ReadProcessMemory(hProc, pText, @lpBuf, MAX_TEXT, dwTmp) then
      begin
        if (i > 0) then
          memo2.lines.Append(string(lpBuf));
        tvi.hItem := HTREEITEM(SendMessage(hTVwnd, TVM_GETNEXTITEM, TVGN_NEXTVISIBLE, Integer(tvi.hItem)));
      end else break;
    end;
  end; // else: "could not get process handle"

  if Assigned(pAddr) then
    VirtualFreeEx(hProc, pAddr, 0, MEM_RELEASE);
  if Assigned(pText) then
    VirtualFreeEx(hProc, pText, 0, MEM_RELEASE);
  CloseHandle(hProc);
end;[/code]

[code]function RetrieveText(target: TMemo; hwnd: HWND; wndclass: string): BOOL;
(*
  - target is clear ... just the memo into which to output stuff
  - trgtwnd is the target's window handle
  - wndclass is the window class. this should be determined using
    GetWindowClass(). It's just to distinguish the types because
    listboxes are treated differently from treeviews or listviews.

  NOTE: this function ignores any errors:
  - the target could delete items meanwhile!
  - the target could replace a short item by a long one which will
    result in our buffer being too small -> buffer overflow.
*)
var
  err,
    num, // number of items
    i, // current index
    l: Integer; // length
  hProcess: THandle;
  dwprocID: DWORD;
  szText: PChar;
begin
  if IsWindow(hwnd) then
(*
  begin
    GetWindowThreadProcessId(hWnd, @dwprocID);
    hProcess := OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ {or PROCESS_VM_WRITE}, FALSE, dwprocID);
  end;
  if hProcess <> 0 then
*)
  try
    if (lstrcmpi(@wndclass[1], 'Listbox') = 0) or (lstrcmpi(@wndclass[1], 'TListbox') = 0) then
(*
  This check should be extended for more window classes ...
  also MFC class names need to be included.
  Although some windows are wrapped by classes, they ultimately
  can be controlled by the standard Win32 API.
*)
    begin
// Check wether the listbox hold strings (else it could be any data format ...
      if (GetWindowLong(hwnd, GWL_STYLE) and LBS_HASSTRINGS) <> 0 then
      begin
// First get the number of entries in the listbox
        num := SendMessage(hwnd, LB_GETCOUNT, 0, 0);
// Only proceed if no error
        if num <> LB_ERR then
          for i := 0 to num - 1 do
          begin
// Get size of item in TChars and calculate the size needed in AnsiChars ...
            l := (SendMessage(hwnd, LB_GETTEXTLEN, i, 0) + 1);
// Allocate the mem in target process
            szText := GetMemory(l);
            //VirtualAllocEx(hProcess, nil, l, MEM_RESERVE or MEM_COMMIT, PAGE_READWRITE);
// Check for error
            if Assigned(szText) then
            try
              err := SendMessage(hwnd, LB_GETTEXT, i, Integer(szText));
              if err <> LB_ERR then
              begin
// Add to target memo
                if target.Text = '' then
                  target.Text := string(szText)
                else
                  target.Text := target.Text + #13#10 + string(szText);
              end
              else
                ; // Drop error message ...
            finally
// Free the memory in the target process
              Freememory(szText);
//              VirtualFreeEx(hProcess, szText, 0, MEM_RELEASE);
            end;
          end;
      end;
    end;
  finally
// Finally close the handle
//    CloseHandle(hProcess);
  end
  else
  begin
    // Drop error message and fail ...
    exit;
  end;
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:

uses
  shlObj, ShellApi, ClipBrd;

// die Prozedur habe ich aus dem Swissdelphicenter
// sie kopiert die im Parameter FileList angegebenen Dateien in die
// Zwischenablage. FileList ist ein String, die einzelnen Dateien werden
// mit #0 voneinander getrennt
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;
end;

//hier mein Aufruf
procedure TForm1.Button1Click(Sender: TObject);
var
  i, x: Integer;
  Filelist: string;
begin
  for i := 0 to shlLw.SelCount - 1 do
  begin
    x := shlLw.Selected.Index;
    FileList := FileList + shlLw.Folders[x+i].PathName+#0;
  end;
  CopyFilesToClipboard(FileList);
end;

// jetzt der Code zum Einfügen
// stammt teilweise aus dem Swissdelphicenter und teilweise von mir
procedure TForm1.Button2Click(Sender: TObject);
var
  f: THandle;
  buffer: array [0..MAX_PATH] of Char;
  i, numFiles: Integer;
  str: String;
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);
      for i := 0 to numfiles - 1 do
      begin
        buffer[0] := #0;
        DragQueryFile(f, i, buffer, SizeOf(buffer));
        str := buffer;
        CopyFile(PChar(str), PChar( shlLw.RootFolder.PathName + '\' + 
                                                  ExtractFileName(str)), False);
      end;
    end;
  finally
    Clipboard.Close;
  end;
  shlLw.Refresh;
end;