Sub GetOpenedFolder()
Dim MShell As New Shell
Dim SFV As ShellFolderView
Lb.Items.Clear()
On Error Resume Next
For Each o In MShell.Windows
If TypeName(o.document) <> "HTMLDocument" Then
SFV = o.document
If SFV.Folder.Items.Count > 0 Then
Lb.Items.Add(TrimPath(CType(SFV.Folder.Items(0), _
ShellFolderItem).Path))
End If
End If
Next
End Sub
Anladığım kadarıyla kod bir dizin içindeki HTML dosyaların listesini hazırlıyor. Benzer işlem aşağıdaki gibi yapılabilir. Örnek kod form üzerinde ListBox1 adında bir TListBox nesnesi olduğunu varsayıyor.
uses
System.SysUtils,
System.IOUtils;
procedure GetOpenedFolder(const Folder, Filter: string; AList: TStrings);
var
SearchRec: TSearchRec;
Res: Integer;
begin
AList.Clear();
Res := FindFirst(ExtractFilePath(Folder) + TPath.DirectorySeparatorChar + Filter, faAnyfile, SearchRec);
if Res = 0 then
try
while Res = 0 do
begin
if (SearchRec.Attr and faDirectory <> faDirectory) then
AList.Add(SearchRec.Name);
Res := FindNext(SearchRec);
end;
finally
FindClose(SearchRec);
end;
end;
Kullanımı VB.NET kodu ile birebir aynı olmasa da aşağıdaki gibidir
carsoft yazdı:Delphi 7 kullanıyorum bu procedure olmadı
vb.net kodla windows explorer açık dosya listesini alabiliyorum ama
fonksiyonu delphiye çeviremedim ayrıca shell32.dll import edilmiş vb.net'de çeviremedim 2 gündür bunu delphiye
Procedure olmadı derken sorun/hatayı bildirmenizde fayda var. Sizin durumunuzda son sürümlerde kullanılan System.IOUtils içinde tanımlı TPath kullanımı ile ilgili derleme hatası aldığınızı varsayıyorum. Aşağıdaki şekilde değiştirilerek Delphi 7 ile çalışır hale gelecektir.
uses
System.SysUtils;
procedure GetOpenedFolder(const Folder, Filter: string; AList: TStrings);
var
SearchRec: TSearchRec;
Res: Integer;
begin
AList.Clear();
Res := FindFirst(ExtractFilePath(Folder) + '\' + Filter, faAnyfile, SearchRec);
if Res = 0 then
try
while Res = 0 do
begin
if (SearchRec.Attr and faDirectory <> faDirectory) then
AList.Add(SearchRec.Name);
Res := FindNext(SearchRec);
end;
finally
FindClose(SearchRec);
end;
end;
Öncelikle Delphi içinde Component->Import Component seçeneği altından ActiveX olarak Shell32.dll için bir Unit oluşturun. Her sistem için aynı isim olur mu bilmiyorum. Benim sistemimde Shell32_TLB adında oluşturdu bu unit'i.
Kod aşağıdaki gibidir. Dizin veya dosya seçili olmasına göre ekrandaki bir Memo nesnesi içine bilgileri listeliyor. İhtiyacınıza göre TStringList içine veya farklı bir yere bu bilgileri kaydedebilirsiniz.
uses
System.IOUtils,
Shell32_TLB;
procedure TForm15.Button1Click(Sender: TObject);
var
App: Shell;
Windows: OleVariant;
View: ShellFolderView;
I: Integer;
Path: string;
begin
Memo1.Clear();
App := CoShell.Create();
Windows := App.Windows;
for I := 0 to Windows.Count - 1 do
begin
if (Supports(Windows.item[I].document, ShellFolderView, View)) then
begin
if (Assigned(View.FocusedItem)) then
begin
Path := View.FocusedItem.Path;
if (TDirectory.Exists(Path)) then
begin
Memo1.Lines.Add(Format('Selected path: %s', [Path]));
end
else if (TFile.Exists(Path)) then
begin
Memo1.Lines.Add(Format('Selected file: %s', [Path]));
end;
end;
end;
end;
end;
Yukarıdaki kısım gözden kaçmış. Oluşan hataları gözardı etmemiz gerekiyor. Hata oluşan kısımı try..except bloğu içine alıp except kısmını boş bırakarak deneyebilir misiniz?
1- Delphi 7'de sorun yaşıyor olabilirsiniz. Ben kodu Delphi 10.1 ve Windows 10 64bit altında test ettiğimde try..except bloğu olmadan sorunsuz çalışıyor. Hiç hata mesajı almıyıyorum ve Memo içeriği doluyor.
2- Diğer bir ihtimal kod çalıştığı sırada hiç açık Windows Explorer penceresi olmayabilir.
Direk kullanımı mümkün olmayabilir. Ancak aşağıda ekte kendi sistemimde oluşturulan Shell32_TLB.pas dosyasını bulabilirsiniz.
Vazgeçmeden önce son olarak aşağıdaki şekilde Delphi 7 ile derleyebiliyor musunuz? Çalışma zamanında yine hata veriyor mu? Memo nesnesinin içi doluyor kontrol edebilir misiniz?
uses
IOUtils,
Shell32_TLB;
procedure TForm15.Button1Click(Sender: TObject);
function IsShellFolderView(Window: IDispatch; var View): Boolean;
var
IE: InternetExplorer;
begin
try
Result := Supports(Window, InternetExplorer, IE);
if (Result) then
begin
Result := Supports(IE.Document, ShellFolderView, View);
end;
except
Result := False;
end;
end;
var
App: Shell;
Windows: OleVariant;
View: ShellFolderView;
I: Integer;
Path: string;
begin
Memo1.Clear();
App := CoShell.Create();
Windows := App.Windows;
for I := 0 to Windows.Count - 1 do
begin
if (IsShellFolderView(Windows.item[I], View)) then
begin
if (Assigned(View.FocusedItem)) then
begin
Path := View.FocusedItem.Path;
if (TDirectory.Exists(Path)) then
begin
Memo1.Lines.Add(Format('Selected path: %s', [Path]));
end
else if (TFile.Exists(Path)) then
begin
Memo1.Lines.Add(Format('Selected file: %s', [Path]));
end;
end;
end;
end;
end;
Güncelleme:
uses kısmına SHDocVw eklemek gerekli. Eğer Delphi 7 bulamıyor ise ieframe.dll dosyasından daha önce bahsedildiği gibi import edilmesi gerekiyor.