[Jlovenpk1|seyu]

ОБНОВЛЯЮ ПЕРВЫЙ ПОСТ.

Вообще я Ленивый человек, мне все лень делать, но когда я берусь за delphi и думаю - Что бы сделать полезное для себя и опыта набраться.
Было много ужасных программ, которые не работали нормально, а другие и вовсе не раз сносили мне винду))
В итоге, я решил создать кое - что, что не раз видел в фильмах о будущем ^^
В общем, я это программу хочу довести до ума(ИИ), но это еще в планах(то есть летом может быть возьмусь )
Скачать(новая версия) -Скачать
СкринШот -

Код программы:

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Menus,shellapi, ExtCtrls, registry;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Button1: TButton;
    Button2: TButton;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    QBasic1: TMenuItem;
    FreeBasic1: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    Lineage21: TMenuItem;
    N6: TMenuItem;
    Delphi1: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    skype1: TMenuItem;
    Email1: TMenuItem;
    N9: TMenuItem;
    httpwwwdelphisourcesruforumindexphp1: TMenuItem;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure QBasic1Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure FreeBasic1Click(Sender: TObject);
    procedure Lineage21Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure N8Click(Sender: TObject);
    procedure skype1Click(Sender: TObject);
    procedure Email1Click(Sender: TObject);
    procedure httpwwwdelphisourcesruforumindexphp1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Unit2, Unit3;

{$R *.dfm}

procedure run(what: string);
begin
ShellExecute(0, 'open', pchar(what), nil, nil,1);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
ans: integer;
var
reg: tregistry;

begin
reg := tregistry.create;
reg.rootkey := hkey_local_machine;
reg.lazywrite := false;
reg.openkey('software\microsoft\windows\currentversion\run', false);
reg.writestring('progrmma', application.exename); {вместо programma можно вставить что нибудь своё}
reg.closekey;

randomize;
ans := random(5);
case ans of
  0: label2.caption := 'Высокомерие это стена скрывающая страхи и сомнения';
  1: label2.caption := ' Не все то истина, что находится в учебнике ' ;
  2: label2.caption := 'Все разрешено, что не запрещено законом. ';
  3: label2.caption := ' Один страж, сильнее 10 солдат. ' ;
  4: label2.caption := ' Сила есть, ума не надо. ';

end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
  if InputBox('Загадка','Сидит дед, в сто шуб одет. Кто его раздевает - тот слёзы проливает. Кто это?','') = 'лук' then
    MessageDlg('Правильно!',mtInformation,[mbOk],0)
  else
    MessageDlg('Вы не угадали.',mtWarning,[mbOk],0)
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
form2.show;
end;

procedure TForm1.N2Click(Sender: TObject);
begin
  form2.show;
end;

procedure TForm1.N3Click(Sender: TObject);
begin
form3.show;
end;

procedure TForm1.QBasic1Click(Sender: TObject);
begin
run ('http://qbasic.su');


end;

procedure TForm1.N4Click(Sender: TObject);
begin
   if inputbox('Плак',' Вы подождете реализации этой функции?)[Да,Нет]','')='да' then
  MessageDlg('Скоро будет^^',mtInformation,[mbOK],0)
  else
  MessageDlg(' Да не, лови вирус!!',mtInformation,[mbok],0)
end;

procedure TForm1.FreeBasic1Click(Sender: TObject);
begin
if inputbox('Плак',' Вы подождете реализации этой функции?)[Да,Нет]','')='да' then
  MessageDlg('Скоро будет^^',mtInformation,[mbOK],0)
  else
  MessageDlg(' Да не, лови вирус!!',mtInformation,[mbok],0)
end;

procedure TForm1.Lineage21Click(Sender: TObject);
begin
winexec('C:\Lineage 2 The Chaotic Throne High Five 5\Lineage 2 The Chaotic Throne High Five 5\hfive.exe',SW_SHOW);
end;

procedure TForm1.N6Click(Sender: TObject);
begin
 run ('http://google.ru');
end;

procedure TForm1.N8Click(Sender: TObject);
begin
  run ('http://Jlovenpk1.clan.su');
end;

procedure TForm1.skype1Click(Sender: TObject);
begin
    MessageDlg('Skype: Seyu451', mtinformation,[mbOK],0)
end;

procedure TForm1.Email1Click(Sender: TObject);
begin
  MessageDlg('E-mail: Jlovenpk1@mail.ru',mtinformation,[mbOK],0)
end;

procedure TForm1.httpwwwdelphisourcesruforumindexphp1Click(
  Sender: TObject);
begin
  Run('http://www.delphisources.ru/')
end;

end.

[angvelem]

WinExec, оставлена для совместимости. Лучше использовать ShellExecute или CreateProcess.

[Jlovenpk1|seyu]

Если не тяжело будет, в лс примерный код =)
заранее спасибо)

[angvelem]

Код:

var
  StartInfo : TStartupInfo;
  ProcInfo  : TProcessInformation;
begin
  ShellExecute(0, 'Open', PChar('D:\Program Files\Mozilla Firefox\Firefox.exe'), '', '', SW_SHOWNORMAL);
  
  FillChar(StartInfo, SizeOf(TStartupInfo), 0);
  StartInfo.cb := SizeOf(TStartupInfo);
  StartInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartInfo.wShowWindow := SW_HIDE;
  if CreateProcess(nil, PChar('D:\Program Files\Mozilla Firefox\Firefox.exe'), nil, nil, False, HIGH_PRIORITY_CLASS, nil, nil, StartInfo, ProcInfo) then
  try
    if WaitForSingleObject(ProcInfo.hProcess, Timeout) <> WAIT_TIMEOUT then
      TerminateProcess(ProcInfo.hProcess, STATUS_TIMEOUT);
  finally
    CloseHandle(ProcInfo.hThread);
    CloseHandle(ProcInfo.hProcess);
  end;

Вот навскидку.

[lmikle]

Лучще ShellExecute:

Код:

  If ShellExecute(Application.Handle,
                  PChar('open'),
                  PChar(AUrl),  // <-- Запускаемый файл
                  Nil,
                  Nil,
                  SW_SHOW) <= 32 Then
    MessageDlg(msgErrorOpenUrl,mtError,[mbOK],0);

[Jlovenpk1|seyu]

Хмм, а есть ли код, который ищет программу на компьютере по имени и запускает.
Т.к не у всех путь как у меня к игре или браузеру))

[ChinYan]

Т.к не у всех путь как у меня к игре или браузеру))

Что вполне закономерно... Проще всего - искать в реестре пути к поддерживаемым программам, или указывать пути в каких-нибудь ннастройках

[lmikle]

вообще, shellexecute именно это и делает.
но, как всегда, есть особенности. Если программа доступна по стандартным путям поиска - то найдет. Если нет - то не найдет.

Кстати, там можно запускать не только программу, но и файл или url.
В приведенном примере AUrl - это просто internet-адрес, типа http://www.site.com/bla-bla-bla.html. Запускается дефолтный браузер и открывается указанный урл.

[Jlovenpk1|seyu]

Вам легко говорить, у вас в этом была практика)
Я не научусь только по словам и точкам, мне нужна именно практически отработать(прям как в паркуре)
Так вот, если есть такой код, выложите пожалуйста я его тестану у себя на компьютере))

[Pyro]

PHP код:

uses
  .........., ShellApi;

..............

procedure run(what: string);
begin
  ShellExecute(0, 'open', pchar(what), nil, nil, 1);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  run('http://ya.ru');
  run('calc');
end; 


вместо кнопок можно взять Timage с изображением

[Jlovenpk1|seyu]

Щас закончилось троеборье, пару дней отдохну)
Новую версию скину ^__^

[Jlovenpk1|seyu]

обновил 1 пост)