[minou]

Code:

unit RegisterFile;

interface
uses Registry, ShlObj, SysUtils, Windows;

procedure RegisterFileType(cMyExt, cMyFileType, cMyDescription, ExeName: string; IcoIndex: integer; DoUpdate: boolean = false);

implementation

procedure RegisterFileType(cMyExt, cMyFileType, cMyDescription, ExeName: string; IcoIndex: integer; DoUpdate: boolean = false);
var
Reg: TRegistry;
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_CLASSES_ROOT;
Reg.OpenKey(cMyExt, True);
// Write my file type to it.
// This adds HKEY_CLASSES_ROOT.abc(Default) = 'Project1.FileType'
Reg.WriteString('', cMyFileType);
Reg.CloseKey;
// Now create an association for that file type
Reg.OpenKey(cMyFileType, True);
// This adds HKEY_CLASSES_ROOTProject1.FileType(Default)
// = 'Project1 File'
// This is what you see in the file type description for
// the a file's properties.
Reg.WriteString('', cMyDescription);
Reg.CloseKey; // Now write the default icon for my file type
// This adds HKEY_CLASSES_ROOTProject1.FileTypeDefaultIcon
// (Default) = 'Application DirProject1.exe,0'
Reg.OpenKey(cMyFileType + 'DefaultIcon', True);
Reg.WriteString('', ExeName + ',' + IntToStr(IcoIndex));
Reg.CloseKey;
// Now write the open action in explorer
Reg.OpenKey(cMyFileType + 'ShellOpen', True);
Reg.WriteString('', '&Open');
Reg.CloseKey;
// Write what application to open it with
// This adds HKEY_CLASSES_ROOTProject1.FileTypeShellOpenCommand
// (Default) = '”Application DirProject1.exe” “%1″'
// Your application must scan the command line parameters
// to see what file was passed to it.
Reg.OpenKey(cMyFileType + 'ShellOpenCommand', True);
Reg.WriteString('', '”' + ExeName + '” “%1″');
Reg.CloseKey;
// Finally, we want the Windows Explorer to realize we added
// our file type by using the SHChangeNotify API.
if DoUpdate then SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil);
finally
Reg.Free;
end;
end;

end.

main

Code:

function ExtractFileNameEX(const AFileName:String): String;
var
I: integer;
begin
I := LastDelimiter('.'+PathDelim+DriveDelim,AFileName);
if (I=0) or (AFileName <> '.')
then
I := MaxInt;
Result := ExtractFileName(Copy(AFileName,1,I-1));
end;

procedure RegisterStyle(Enabled:Boolean=False);
begin
with TIniFile.Create('config.ini')do try
if not ReadBool('setting','APPStyle',Enabled) then
RegisterFileType('.SSSKIN', '.SSSKIN', 'AdanAPPStyle', ParamStr(0), 1,True);
WriteBool('setting','APPStyle',True);
finally
Free;
end;
end;

function curDir:string;
begin
Result:=ExtractFilePath(ParamStr(0))
end;

procedure TForm1.SetAlphaSkin(_dialog:Boolean=False;_path:Boolean=False);
var asz,nameex:string;
begin
try
if not DirectoryExists(curDir+'Skins') then CreateDir(curDir+'Skins') ;
sSkinManager1.SkinDirectory := curDir+'Skins';
finally
if _dialog then begin
SelectSkin(sSkinManager1);
nameex:=sSkinManager1.skinname;
end;

if _path then
begin
nameex:=ExtractFileNameEX( ParamStr(1));
asz:= curdir+'Skins'+nameex+'.asz' ;
CopyFile(PChar(ParamStr(1)),PChar(asz),True) ;
end ;

sSkinManager1.skinname:=nameex;
sStoreUtils.WriteIniStr('setting', 'SkinName', nameex, 'config.ini');

end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var nameEX:string;
begin
sStoreUtils.WriteIniStr('setting', 'ProcessID',inttostr(GetCurrentProcessId) ,'config.ini');

//————————————————————————————–
if pos('.ssskin',LowerCase(ParamStr(1)))>0 then begin
nameex:=ExtractFileNameEX( ParamStr(1));
if MessageDlg(' الى البرنامج ؟ ( '+nameex+' ) هل تريد اضافة هذا الشكل ' ,mtConfirmation,[mbok,mbcancel], 0)=1 then begin
SetAlphaSkin(False,True);
end;

end else begin
sSkinManager1.SkinDirectory := curDir+'Skins';
sSkinManager1.SkinName := sStoreUtils.ReadIniString('setting', 'SkinName', 'config.ini');
end;
//—————————————————————————————-
RegisterStyle;
end;

Code:

program Project1;

{$R *.dres}

uses
Vcl.Forms,System.SysUtils,System.IniFiles,Winapi.Windows,JclAppInst,Unit1 in 'Unit1.pas' {Form1};

{$R *.res}
function TerminateProcessByID(ProcessID: Cardinal): Boolean;var hProcess : THandle;begin Result := False;hProcess := OpenProcess(PROCESS_TERMINATE,False,ProcessID);if hProcess > 0 then try Result := Win32Check(TerminateProcess(hProcess,0));finally CloseHandle(hProcess);end;end;
function GetProcessID:Integer;begin with tinifile.Create('config.ini') do try result:= ReadInteger('setting','ProcessID',0 );finally Free;end;end;

begin
if pos('.ssskin',LowerCase(ParamStr(1)))=0 then
JclAppInstances.CheckSingleInstance else // Added instance checking
TerminateProcessByID(GetProcessID) ;//kill last app_process_id
Application.Initialize;
Application.MainFormOnTaskbar := False;
Application.CreateForm(TForm1, Form1);
Form1.DoubleBuffered := True;
Application.Run;
end.

[Support]

Thank you!

[minou]

Demo with source

[minou]

version 2[attachment=7354:alpha_2.rar]

[Author]

Posts