Yönetici Olarak Çalışan Programa Dosya Sürükleme Problemi

[sabanakman]

İyi günler. Normalde aşağıdaki kodlarla herhangi bir sıkıntı yaşamadan formlarımıza windows gezginlerinden dosyaları sürükle bırak ile taşınabiliyordu.

Kod: Tümünü seç

uses ShellAPI;

procedure TForm1.FormCreate(Sender: TObject);
begin
  DragAcceptFiles(Handle, True);
end;

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
const   BufferLength : DWORD = 511;
var
   DroppedFilename,Ext : String;
   FileIndex           : DWORD;
   NumDroppedFiles     : DWORD;
   pDroppedFilename    : array [0..511] of Char;

begin
  if Msg.message=WM_DROPFILES then begin
     FileIndex := $FFFFFFFF;
     NumDroppedFiles := DragQueryFile(Msg.WParam, FileIndex,
                                      pDroppedFilename, BufferLength);
     DroppedFilename:='';
     ListBox1.Items.Clear;//
     for FileIndex := 0 to (NumDroppedFiles - 1) do begin
       //DroppedFileLength :=
       DragQueryFile(Msg.WParam, FileIndex, pDroppedFilename, BufferLength);
       //Inc(Top,DroppedFileLength);
       DroppedFilename := StrPas(pDroppedFilename);
       if FileExists(DroppedFilename) then try

         ListBox1.Items.Add(DroppedFilename);//<--sürüklenen dosyalar

       except
         on E:Exception do begin
           ShowMessage(Format('%s dosyası açılırken bir hata oluştu.'#13#10'%s',[DroppedFilename,E.Message]));
         end;
       end;
     end;
     DragFinish(Msg.WParam);
     Handled := True;
  end;
end;

Aslında bu kod halen çalışıyor fakat kullanıcı hesabına takılmamak için UAC izinlerini alarak çalışan bir uygulama haline dönüştürdüğümüz vakit (veya aynı çalışan uygulamaya sadece sağ tıklayıp yönetici olarak çalıştır dersek de) bu kodlar bir işe yaramamaktadır. Bununla ilgili bir çalışması veya önerisi olan var mıdır acep ? İyi çalışmalar.

[mrmarman]

Merhaba.

- Bir anekdot ile konuya gireyim: Eski projelerimden birinde de aynı sorunu yaşamıştım. Çoklu taşıma için VIDEO ve ALTYAZI dosyalarını topluca seçip benim projeye taşıdıklarında, bu dosyaların değerlendirilmediğine ilişkin şikayetler gelmişti. Ben de bunun sebebini bir türlü anlayamamıştım, çünkü bende çalışıyordu ... Taa ki UAC sorunu olduğunu tespit edene kadar.

- Sen sorunun nereden kaynaklı olduğunu biliyorsun, bu büyük şans olmuş, adına sevindim. Keza sorunun adını koyunca çözümü de dolayısıyla kolay oluyor.

Aşağıdaki kod işini görecektir. Bende yaradı. Sorunun kaynağı, daha alt yetki seviyedeki bir uygulama, daha üst seviyedeki bir uygulamaya mesaj yollayamıyor kuralından kaynaklı. Aşağıdaki kod ile bizim projenin "hani derler ya çakralarını açmak" daha alt seviye mesajlara da bakmasını sağlıyoruz.

bkz. ref : MSDN

Kod: Tümünü seç

procedure TForm1.FormCreate(Sender: TObject);
Const
    WM_COPYGLOBALDATA = $0049;
    MSGFLT_ADD        = 1;
begin
  ChangeWindowMessageFilter (WM_DROPFILES, MSGFLT_ADD);
  ChangeWindowMessageFilter (WM_COPYDATA, MSGFLT_ADD);
  ChangeWindowMessageFilter (WM_COPYGLOBALDATA, MSGFLT_ADD);

  DragAcceptFiles(Handle, True);
end;

[sabanakman]

Sorunun kaynağını bulmak biraz üşengeçlikten oldu. Zira UAC denetimi ekleyene kadar sağ tıklayarak yönetici çalıştır yaparak geçinip giderken fark ettim sorunu . Verdiğiniz kod tam olarak işe yaradı çok teşekkürler. Delphi7'de ChangeWindowMessageFilter fonksiyonu tanımlı olmadığından ve de programın xp uyumluluğunun devam etmesi açısından biraz aşağıdaki gibi bir rötuşla program sorun çıkarmadan çalışmaktadır.

Kod: Tümünü seç

type
  TChangeWindowMessageFilter=function (Message: UINT; dwFlag: DWORD): BOOL; stdcall;
var
  ChangeWindowMessageFilter:TChangeWindowMessageFilter=nil;

implementation

....

procedure TAnaForm.FormCreate(Sender: TObject);
const
  WM_COPYGLOBALDATA = $0049;
  MSGFLT_ADD        = 1;
begin
  if Assigned(ChangeWindowMessageFilter) then begin
    ChangeWindowMessageFilter(WM_DROPFILES, MSGFLT_ADD);
    ChangeWindowMessageFilter(WM_COPYDATA, MSGFLT_ADD);
    ChangeWindowMessageFilter(WM_COPYGLOBALDATA, MSGFLT_ADD);
  end;
  DragAcceptFiles(Handle, True);
.....
end;
////.....
//function ChangeWindowMessageFilter(Message: UINT; dwFlag: DWORD): BOOL; stdcall; external user32 name 'ChangeWindowMessageFilter' delayed;
function dllYukle;
var huser32: Integer;
begin
  //Result:=False;
  huser32:=LoadLibrary('user32.dll');
  if huser32=0 then RaiseLastOSError;
  @ChangeWindowMessageFilter:=GetProcAddress(huser32,'ChangeWindowMessageFilter');
  Result:=Assigned(ChangeWindowMessageFilter);
end;

initialization
//
  dllYukle;
finalization
//
end.

[mrmarman]

Merhaba.

- XP uyum konusunda notumu aldım, teşekkürler.

[Lost Soul]

Ben hepsini not aldım teşekkürler