Форум АНТИЧАТ - Показать сообщение отдельно - Полезные программы (собственные)

FastLauncher
прога добавляет ярлык в %systemDirectory% что позволяет запускать ее из коммандной строки, либо Win+R/Диспетчер задач -> Новая задача

http://slil.ru/25970580

Скомпилированна в Delphi7.

PHP код:


		
			
program FL;



uses

  Windows, ShlObj, ActiveX, SysUtils;



const

  About = 'Coded by: W!z@rD Special build: www.antichat.ru';



  MAXSIZE = 260;

  OFN_FILEMUSTEXIST = $00001000;

  OFN_PATHMUSTEXIST = $00000800;

  OFN_HIDEREADONLY  = $00000004;

  OFN_LONGNAMES     = $00200000;



  WM_COMMAND = $0111;

  WM_DESTROY = $0002;

  WM_CLOSE   = $0010;



type

TOpenFilenameA = packed record

  lStructSize: DWORD;

  hWndOwner: HWND;

  hInstance: HINST;

  lpstrFilter: PAnsiChar;

  lpstrCustomFilter: PAnsiChar;

  nMaxCustFilter: DWORD;

  nFilterIndex: DWORD;

  lpstrFile: PAnsiChar;

  nMaxFile: DWORD;

  lpstrFileTitle: PAnsiChar;

  nMaxFileTitle: DWORD;

  lpstrInitialDir: PAnsiChar;

  lpstrTitle: PAnsiChar;

  Flags: DWORD;

  nFileOffset: Word;

  nFileExtension: Word;

  lpstrDefExt: PAnsiChar;

  lCustData: LPARAM;

  lpfnHook: function(Wnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM):UINT stdcall;

  lpTemplateName: PAnsiChar;

end;

  TOpenFilename = TOpenFilenameA;



function GetOpenFileName(var OpenFile: TOpenFilename): BOOL;

  stdcall; external 'comdlg32.dll' name 'GetOpenFileNameA';



{$R dialog.res}



var

  TheFile: string;

  buf: array [0..MAXSIZE-1] of Char;

  ofn: TOpenFileName;



procedure OleCheck(Result: HResult);

begin

  if Result < 0 then Exit;

end;



function CreateComObject(const ClassID: TGUID): IUnknown;

begin

  OleCheck(CoCreateInstance(ClassID, nil, CLSCTX_INPROC_SERVER or CLSCTX_LOCAL_SERVER, IUnknown, Result));

end;



procedure OpenFileDlg;

begin

  ofn.lStructSize:=SizeOf(TOpenFileName);

  ofn.hWndOwner  :=0;

  ofn.hInstance  :=HInstance;

  ofn.lpstrFilter:=nil;

  ofn.lpstrFile  :=buf;

  ofn.nMaxFile   :=MAXSIZE;

  ofn.Flags      :=OFN_FILEMUSTEXIST or OFN_PATHMUSTEXIST or OFN_LONGNAMES or OFN_HIDEREADONLY;

  if GetOpenFileName(ofn) then TheFile:=ofn.lpstrFile;

end;



function GetSysDir: string;

var

  buf: array [0..MAX_PATH] of Char;

begin

  GetSystemDirectory(buf, MAX_PATH);

  Result:=buf;

end;



function Install(_file: string): Boolean;

var

LnkName   : string;

MyObject  : IUnknown;

MyIcon    : IShellLink;

MyPFile   : IPersistFile;

WFileName : WideString;

begin

  try

    CoInitialize(nil);

    MyObject:=CreateComObject(CLSID_ShellLink);

    MyIcon:=MyObject as IShellLink;

    MyPFile:=MyObject as IPersistFile;

    with MyIcon do

    begin

      SetArguments(PChar(''));

      SetPath(PChar(_file));

      SetWorkingDirectory(PChar(ExtractFilePath(_file)));

    end;

    LnkName:=Copy(ExtractFileName(_file), 1, Length(ExtractFileName(_file)) - Length(ExtractFileExt(_file)));

    WFileName:=GetSysDir + '\' + LnkName + '.lnk';

    MyPFile.Save(PWChar(WFileName), False);

  except

    Result:=False;

    Exit;

  end;

  Result:=True;

end;



function DlgProc(hWin:HWND; uMsg:UINT; wp:WPARAM; lp:LPARAM): BOOL; stdcall;

begin

  Result:=False;

  case uMsg of

    WM_COMMAND:

    case LoWord(wp) of

      3: begin

        OpenFileDlg;

        SetWindowText(GetDlgItem(hWin, 2), PChar(TheFile));

      end;

      4: begin

        if not FileExists(TheFile) then

        MessageBox(hWin, 'File not exists!', 'FL', MB_ICONERROR or MB_APPLMODAL)

        else

        if Install(TheFile) then MessageBox(hWin, 'Done!', 'FL', MB_APPLMODAL);

        end;

      5: MessageBox(hWin, About, 'FL', MB_APPLMODAL);

    end;

    WM_DESTROY, WM_CLOSE: PostQuitMessage(0);

  end;

end;



begin

  DialogBox(hInstance, 'frmMain', 0, @DlgProc);

end.