dEEpEst Posted July 28, 2015 Share Posted July 28, 2015 Credits: W! Z @ rD FastLauncher the program adds a shortcut to% systemDirectory% allowing you to run it from the command line, or Win + R / Task Manager -> New Task Are compiled in Delphi7. [HIDE-THANKS][LENGUAJE=delphi]program FL ; uses Windows , ShlObj , ActiveX , SysUtils ; const About = 'Coded by: W!z@rD ; 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 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.[/LENGUAJE][/HIDE-THANKS] Link to comment Share on other sites More sharing options...
Recommended Posts