delphi dos command form dondurma sorunu

[seci20]

merhaba ustalarım dos command için şu component kullanıyorum.

Kod: Tümünü seç

function IsWinNT: boolean;
var
  OSV: OSVERSIONINFO;
begin
  OSV.dwOSVersionInfoSize := sizeof(osv);
  GetVersionEx(OSV);
  result := OSV.dwPlatformId = VER_PLATFORM_WIN32_NT;
end;

function cmdxcx(Cmd: string): string;
var
  Buffer: array[0..4096] of Char;
  si: STARTUPINFO;
  sa: SECURITY_ATTRIBUTES;
  sd: SECURITY_DESCRIPTOR;
  pi: PROCESS_INFORMATION;
  newstdin, newstdout, read_stdout, write_stdin: THandle;
  exitcod, bread, avail: Cardinal;
  Str: string;
begin
  Result:= '';
  if IsWinNT then
  begin
    InitializeSecurityDescriptor(@sd, SECURITY_DESCRIPTOR_REVISION);
    SetSecurityDescriptorDacl(@sd, true, nil, false);
    sa.lpSecurityDescriptor := @sd;
  end
  else sa.lpSecurityDescriptor := nil;
  sa.nLength := sizeof(SECURITY_ATTRIBUTES);
  sa.bInheritHandle := TRUE;
  if CreatePipe(newstdin, write_stdin, @sa, 0) then
  begin
    if CreatePipe(read_stdout, newstdout, @sa, 0) then
    begin
      GetStartupInfo(si);
      with si do
      begin
        dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
        wShowWindow := SW_HIDE;
        hStdOutput := newstdout;
        hStdError := newstdout;
        hStdInput := newstdin;
      end;
      Fillchar(Buffer, SizeOf(Buffer), 0);
      GetEnvironmentVariable('COMSPEC', @Buffer, SizeOf(Buffer) - 1);
      StrCat(@Buffer,PChar(' /c ' + Cmd));
      if CreateProcess(nil, @Buffer, nil, nil, TRUE, CREATE_NEW_CONSOLE, nil, nil, si, pi) then
      begin
        Str:= #13;
        WriteFile(write_stdin,PChar(Str)^,Length(Str),bread,nil);
        repeat
          PeekNamedPipe(read_stdout, @Buffer, SizeOf(Buffer) - 1, @bread, @avail, nil);
          if bread > 0 then
          begin
            Fillchar(Buffer, SizeOf(Buffer), 0);
            ReadFile(read_stdout, Buffer, bread, bread, nil);
            Result:= Result + String(PChar(@Buffer));
          end;
          GetExitCodeProcess(pi.hProcess, exitcod);
        until (exitcod <> STILL_ACTIVE) and (bread = 0);
      end;
      CloseHandle(read_stdout);
      CloseHandle(newstdout);
    end;
    CloseHandle(newstdin);
    CloseHandle(write_stdin);
  end;
end;

ve yapmak istediğim şu adb üzerinden cihaz beklemesi lazım ve gauge 100 oldugunda cihaz bulunamadı yazması lazım ve adb cihaz beklemesini kesmesi lazım.normal şartlarda şunu kullanılıyorum.

Kod: Tümünü seç

if scombobox6.Text= 'Cihaz Oku (Full)' then
sGauge1.Progress:=0;
Delay(2000);
srichedit1.Lines.Add('Cihaz Aranıyor...');
timer2.Enabled:=true;
Delay(1000);
r:=Cmdxcx('adb wait-for-device shell "exit"');
if scombobox5.ItemIndex = -1 = false then
if scombobox6.ItemIndex = -1 = false then
if doscommand1.CommandLine=r then else
srichedit1.Lines.Add('Cihaz Bulunamadı...');
sGauge1.Progress:=100;
if scombobox5.ItemIndex = -1 = false then
if scombobox6.ItemIndex = -1 = false then
if doscommand1.CommandLine=r then
srichedit1.Lines.Add('Cihaz Bulundu...');
Delay(2000);
timer2.Enabled:=false;
end;
end;

timerdede bu kodu kullanıyorum.

Kod: Tümünü seç

procedure TForm2.Timer1Timer(Sender: TObject);
begin
sGauge1.Progress:=sGauge1.Progress+1;
if sGauge1.Progress=100 then
begin
timer1.Enabled:=false;
end;
end;
procedure TForm2.Timer2Timer(Sender: TObject);
begin
sGauge1.Progress:=sGauge1.Progress+1;
if sGauge1.Progress=100 then
begin
KillTask('adb.exe');
timer1.Enabled:=false;
end;
end;

ama bir süre devam ediyor ve stringe gelınce forum donuyor.cihaz takılıyken yanı buldugu vakit sorun yok hemen 2 saniye donup duzelıyor ama bulmadıgı vakit form donuyor timer ilerlemiyor gauge hareket etmiyor.belki alt işlem yapıyordur diye bekledım ama malasef bir sonuc alamadım.bayadır arastıyorum bu konu hakkında bır bılgıye ulasamadım malasef.yardımcı olursanız cok sevınırım.
Not:application.processmessages işimi görmüyor malasef...
Not2:doscommanda sorun yok cunku o saniyesinde işlemini yapıyor.

[G.Arkas]

Daha öncede bu soruna benzer bir cevap vermiştim ve yine vereceğim. Lütfen beni dinle ve şu progressbar sevdasından vazgeç. Anlıyorum görsel koymak istiyorsun ama bu şekilde olmaz. Çözümlerimi aşağıda sıralıyorum işine nasıl gelirse onu kullan.

1- Öncelikle kullandığın Pipe her defasında arka planda bir Cmd.exe açıyor bu işlemlerden sonra onu nasıl kapatıyorsun? (Task Manager'de bunu detaylı olarak görebilirsin. Onlarca Cmd.exe oluşacaktır.)
2- Ben RemoteShell için bir Thread oluşturuyorum. Bu sınıf ile işimi görüyorum sende öyle yapabilirsin.

Kodunu şu şekilde değiştir. Kabaca, kafadan ve test etmeden yazacağım eksik olursa söyle düzeltelim.

Kod: Tümünü seç

var
OutParameter:string;

Kod: Tümünü seç

procedure CmdxCx(p:pointer);stdcall;
var
  Buffer: array[0..4096] of Char;
  si: STARTUPINFO;
  sa: SECURITY_ATTRIBUTES;
  sd: SECURITY_DESCRIPTOR;
  pi: PROCESS_INFORMATION;
  newstdin, newstdout, read_stdout, write_stdin: THandle;
  exitcod, bread, avail: Cardinal;
  Str: string;
begin
  Memo1.Text:= ''; // Burada richedit kullanmanı tavsiye ederim.
  if IsWinNT then
  begin
    InitializeSecurityDescriptor(@sd, SECURITY_DESCRIPTOR_REVISION);
    SetSecurityDescriptorDacl(@sd, true, nil, false);
    sa.lpSecurityDescriptor := @sd;
  end
  else sa.lpSecurityDescriptor := nil;
  sa.nLength := sizeof(SECURITY_ATTRIBUTES);
  sa.bInheritHandle := TRUE;
  if CreatePipe(newstdin, write_stdin, @sa, 0) then
  begin
    if CreatePipe(read_stdout, newstdout, @sa, 0) then
    begin
      GetStartupInfo(si);
      with si do
      begin
        dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
        wShowWindow := SW_HIDE;
        hStdOutput := newstdout;
        hStdError := newstdout;
        hStdInput := newstdin;
      end;
      Fillchar(Buffer, SizeOf(Buffer), 0);
      GetEnvironmentVariable('COMSPEC', @Buffer, SizeOf(Buffer) - 1);
      StrCat(@Buffer,PChar(' /c ' + OutParameter));
      if CreateProcess(nil, @Buffer, nil, nil, TRUE, CREATE_NEW_CONSOLE, nil, nil, si, pi) then
      begin
        Str:= #13;
        WriteFile(write_stdin,PChar(Str)^,Length(Str),bread,nil);
        repeat
          PeekNamedPipe(read_stdout, @Buffer, SizeOf(Buffer) - 1, @bread, @avail, nil);
          if bread > 0 then
          begin
            Fillchar(Buffer, SizeOf(Buffer), 0);
            ReadFile(read_stdout, Buffer, bread, bread, nil);
            Memo1.Text:= Memo1.Text + String(PChar(@Buffer));
          end;
          GetExitCodeProcess(pi.hProcess, exitcod);
        until (exitcod <> STILL_ACTIVE) and (bread = 0);
      end;
      CloseHandle(read_stdout);
      CloseHandle(newstdout);
    end;
    CloseHandle(newstdin);
    CloseHandle(write_stdin);
  end;
end;

Buna göre şu şekilde çağıralım ki sorunsuz çalışabilsin.

Kod: Tümünü seç

procedure BenimCmdGondericim(Parameter:string);
var
ThreadId:Cardinal;
begin
OutParameter:= Parameter;
CreateThread(0, nil, @CmdxCx, nil, 0, ThreadId);
end;

Kullanımı

Kod: Tümünü seç

BenimCmdGondericim('senin_uygulamaya_gonderecegin_komutlar');

3- Ki ben bunu bu şekilde yapmam Zaten WinExec ve ShellExecute gibi bana sunulan hazır Executer'lerim varken ne diye Pipe ile uğraşayım

Hele birde konut çalışmasını bitirdikten sonraki anı yakalayabiliyorsam tadından yenmez.

Kod: Tümünü seç

procedure ExecuteAndWait(const aCommando: string);
var
  tmpStartupInfo: TStartupInfo;
  tmpProcessInformation: TProcessInformation;
  tmpProgram: String;
begin
  tmpProgram := trim(aCommando);
  FillChar(tmpStartupInfo, SizeOf(tmpStartupInfo), 0);
  with tmpStartupInfo do
  begin
    cb := SizeOf(TStartupInfo);
    wShowWindow := SW_HIDE;
  end;

  if CreateProcess(nil, pchar(tmpProgram), nil, nil, true, CREATE_NO_WINDOW,
    nil, nil, tmpStartupInfo, tmpProcessInformation) then
  begin
    // loop every 10 ms
    while WaitForSingleObject(tmpProcessInformation.hProcess, 10) > 0 do
    begin
      Application.ProcessMessages;
    end;
    CloseHandle(tmpProcessInformation.hProcess);
    CloseHandle(tmpProcessInformation.hThread);
  end
  else
  begin
    RaiseLastOSError;
  end;
end;

Yukarıdaki kod ile komutumu gönderirim o sırada kullanıcıya bir marquee gösteririm. (Animasyon Progressbar gibi birşey) işim bittikten sonra mesajımı ekrana vururum. Oldu bitti. Ne diye progressbar peşindesin? Sırf progressbar ekleyeceğim diye projeni bitiremedin. Gerek var mı buna? En kolay şekilde yap her şeyi. Önemli olan işlevdir. Görsellik 2. planda olsun. (Ki görselliğe çooook önem verdiğimi herkes bilir.)

Gerisi sana kalmış. Kolay gelsin.

[seci20]

hocam cevap verdiğiniz için çok teşekkür ederim.amacım progessbar değil ben onu sadece timerdeki zaman için istiyorum yoksa benim için önemi yok orda ornek gosterdım.yukardaki kodda şu kısımda hata veriyor.

Kod: Tümünü seç

 Memo1.Text:= ''; // Burada richedit kullanmanı tavsiye ederim.

Richedit bile yapsam hala aynı hata devam ediyor.Bu arada hocam winexec işimi görmüyor.Winexec örneğin cihaz rootlumu dıye kontrol et dediğimde yanlıs sonuclar cıkartıyor(veya ben beceremedım baya ugrasmıstım.).doscommand kullanmamım en buyuk sebebı bu.

[G.Arkas]

O satirin hata vermesinin sebebi basina hangi siniftan (Formdan) referans aldigini belirtmemenden kaynaklaniyor.

Kod: Tümünü seç

Form1.Memo1.Text

Yada form adin herneyse o sekilde kullan hata vermez.

[seci20]

hocam dediğiniz gibi yaptım oldu çok teşekkür ederim ama şimdide string olarak tanımlıyamıyorum düz komut verebiliriyorum ancak örnek gösterim..

bu önceden ekliyebildiğim kod.

Kod: Tümünü seç

var
r:string;
begin
r:=Cmdxcx('adb shell su -c su -c exit');
if doscommand1.CommandLine=r then else    ShowMessage('Cihaz Bulunamadı.');

şimdi ise string olarak tanımlıyamıyorum onuda geçtim memoya dahi ekliyemiyorum.hata veriyor çevirmeye çalıştım ama nafile olmadı...evet memoya yazıyor ama önceden istediğim alana ekliyebildiğimi şimdi ekliyemiyorum.

[seci20]

bu arada BenimCmdGondericim şeklinde kullanıyorum hocam iki türlüde hata veriyor....

[G.Arkas]

hocam dediğiniz gibi yaptım oldu çok teşekkür ederim ama şimdide string olarak tanımlıyamıyorum düz komut verebiliriyorum ancak örnek gösterim..

bu önceden ekliyebildiğim kod.

Kod: Tümünü seç

var
r:string;
begin
r:=Cmdxcx('adb shell su -c su -c exit');
if doscommand1.CommandLine=r then else    ShowMessage('Cihaz Bulunamadı.');

şimdi ise string olarak tanımlıyamıyorum onuda geçtim memoya dahi ekliyemiyorum.hata veriyor çevirmeye çalıştım ama nafile olmadı...evet memoya yazıyor ama önceden istediğim alana ekliyebildiğimi şimdi ekliyemiyorum.

Bu şekilde kullanamazsın zaten. BenimGondericim procedure'ünü işleteceksin. Ne hatası alıyorsun? Ekran görüntüsü gönder.

[seci20]

buyrun hocam

[mrmarman]

Procedure ile Function olayını karıştırmışsınız. A'ya eşitlediğiniz yapı bir function değil. Pipe gereği içerik memo1'e birikiyor olmalı. Oradan a'ya bir içerik aktarımı deneyin.

[seci20]

hocam amacım memoya aktarmak değilki ordan komutu vermek.zaten memoye aktarıyor sorun yok orda ama direk aktarıyor ornegın su durumdakı gıbı olmuyor.

Kod: Tümünü seç

memo1.lines.add(BenimCmdGondericim('adb shell getprop ro.product.model'));

gibi olmuyor hata veriyor...

[mrmarman]

Aynı hatayı yapıyorsun. BenimCmdGondericim bir procedure. Sana bir değer döndürmez. Yani bir bir önceki hatandaki gibi değişkene eşitleyemez ya da burada aynı hatayı tekrarladığın şekilde bir memo vs. İçin parametre olarak kullanamazsın. Bunun için function olarak yapılandırılması gerekli.

Gürkan'ın procedure aynı şekilde kullandıysan içinfe memoya aktarma zaten yapılıyor. Ayrıca bir çaba sarfetmene lüzum yok ki.

[seci20]

anladım hocam cozdum sorunu cok teşekkür ederim

[G.Arkas]

anladım hocam cozdum sorunu cok teşekkür ederim

Aklında kalması ve bir daha tekrarlanmaması için bu uyarıyı sana yapayım kardeşim.

Procedure değer göndermez. Hiç bir zaman procedure bir değişkene atanmaz. İçerisinde bulunan bir global değişkene atama yaparsın. Function ise mutlaka bir Result döndürmek zorundadır. Function ve Procedure olayını ve değişken yapılarını iyi bilmen lazım. Bunları iyice bir araştır. Kitaplar var (EKitap) bunları okursan senin için iyi olur.

Kolay gelsin.