1
0
mirror of https://github.com/moparisthebest/Simba synced 2024-11-25 10:42:20 -05:00

API-Calls added (can't be turned off at the moment)

Added file association extension (only works for windows)
This commit is contained in:
Niels 2010-05-22 16:07:35 +02:00
parent 3cb659dbf6
commit 67f73ad6c1
3 changed files with 270 additions and 5 deletions

261
Extensions/associate.sex Normal file
View File

@ -0,0 +1,261 @@
program AssociateFiles;
const
Extensions = 'simb,simba,sex';
var
SimbaMenu: TMenuItem;
type
TCharArray = array of Char;
function GetModuleFileName(
Module: Cardinal; FileName: TCharArray; Size: Cardinal
): Cardinal; external 'GetModuleFileNameA@kernel32 stdcall';
function RegCreateKeyEx(
Key: LongWord; lpSubKey: TCharArray{PChar}; Reserved: LongInt; lpClass: Integer;
dwOptions: LongInt; samDesired: LongWord; SecurityAttributes: Integer;
var pResult: LongWord; dwDisposition: TIntegerArray{PInteger}
): LongInt; external 'RegCreateKeyExA@advapi32.dll stdcall';
function RegCloseKeyEx(
Key: LongWord
): Integer; external 'RegCloseKey@advapi32.dll stdcall';
function RegSetValueEx(
Key: LongWord; lpValueName: TCharArray{PChar}; Reserved: LongInt; dwType: LongInt;
Data: TByteArray{PByte}; cbData: LongInt
): Integer; external 'RegSetValueExA@advapi32.dll stdcall';
procedure SHChangeNotify(
EventID: Integer; Flags: Cardinal; Item1, Item2: Integer
); external 'SHChangeNotify@shell32.dll stdcall';
const
REG_OPTION_NON_VOLATILE = 0;
//KEY_ALL_ACCESS = 983130;
KEY_WRITE = 131087;
ERROR_SUCCESS = 0;
ERROR_ACCESS_DENIED = 5;
ERROR_BADKEY = 1010;
ERROR_CANTOPEN = 1011;
ERROR_CANTREAD = 1012;
ERROR_CANTWRITE = 1013;
ERROR_KEY_DELETED = 1018;
HKEY_CLASSES_ROOT = $80000000;
HKEY_CURRENT_USER = $80000001;
HKEY_LOCAL_MACHINE = $80000002;
HKEY_USERS = $80000003;
HKEY_CURRENT_CONFIG = $80000005;
REG_NONE = 0;
REG_SZ = 1;
REG_EXPAND_SZ = 2;
REG_BINARY = 3;
REG_DWORD = 4;
SHCNE_ASSOCCHANGED = $08000000;
SHCNF_IDLIST = 0;
function StringToCharArray(s: string): TCharArray;
var
i, l: Integer;
begin
l := Length(s);
SetLength(Result, l + 1);
for i := l downto 1 do
Result[i - 1] := s[i];
Result[l] := #0;
end;
function StringToByteArray(s: string): TByteArray;
var
i, l: Integer;
begin
l := Length(s);
SetLength(Result, l + 1);
for i := l downto 1 do
Result[i - 1] := Ord(s[i]);
Result[l] := 0;
end;
function SetString(Buffer: TCharArray; Len: Cardinal): string;
var
i: Integer;
begin
if (Len < 1) then
Result := ''
else
begin
SetLength(Result, Len);
for i := 0 to Len - 1 do
Result[i + 1] := Buffer[i];
end;
end;
function GetExeName: string;
var
Buffer: array of Char;
begin
SetLength(Buffer, 261);
Result := SetString(Buffer, GetModuleFileName(0, Buffer, Length(Buffer)));
end;
function RegOpenKey(KeyName: string; Root: LongWord; out Key: LongWord): Boolean;
var
s: TCharArray;
disp: TIntegerArray;
begin
Result := False;
s := StringToCharArray(KeyName); //Conversion to "PChar"
SetLength(disp, 1);
case RegCreateKeyEx(Root, s, 0, 0, REG_OPTION_NON_VOLATILE, KEY_WRITE, 0, Key, disp) of
ERROR_SUCCESS: Result := True;
ERROR_ACCESS_DENIED: WriteLn('Access denied');
ERROR_BADKEY: WriteLn('Bad key');
ERROR_CANTOPEN: WriteLn('Can''t open');
ERROR_CANTREAD: WriteLn('Can''t read');
ERROR_CANTWRITE: WriteLn('Can''t write');
ERROR_KEY_DELETED: WriteLn('Key marked for deletion');
end;
case disp[0] of
1: WriteLn('Key "'+KeyName+'" did not exist and was created.');
2: WriteLn('Key "'+KeyName+'" existed and was simply opened without being changed.');
end;
end;
function RegCloseKey(Key: LongWord): Boolean;
begin
Result := RegCloseKeyEx(Key) = ERROR_SUCCESS;
end;
function RegCreateKey(KeyName: string; Root: LongWord): Boolean;
var
t: LongWord;
begin
if RegOpenKey(KeyName, Root, t) then
Result := RegCloseKey(t)
else
Result := False;
end;
function RegWriteString(Key: LongWord; Name, Value: string): Boolean;
var
n: TCharArray;
v: TByteArray;
begin
n := StringToCharArray(Name);
v := StringToByteArray(Value);
Result := RegSetValueEx(Key, n, 0, REG_SZ, v, Length(v)) = ERROR_SUCCESS;
end;
function AssociateExtension(Extension, ContentType, App: string): Boolean;
var
t: LongWord;
begin
Result := False;
if (Extension = '') then
Exit;
if (not RegOpenKey('.' + Extension, HKEY_CLASSES_ROOT, t)) then
Exit;
RegWriteString(t, '', 'Simba.' + Extension);
if (ContentType <> '') then
RegWriteString(t, 'Content Type', ContentType);
RegCloseKey(t);
if (App <> '') then
begin
if (not RegOpenKey('Simba.' + Extension + '\DefaultIcon', HKEY_CLASSES_ROOT, t)) then
Exit;
RegWriteString(t, '', App + ',0');
RegCloseKey(t);
if (not RegOpenKey('Simba.' + Extension + '\shell', HKEY_CLASSES_ROOT, t)) then
Exit;
RegWriteString(t, '', 'open');
RegCloseKey(t);
if (not RegOpenKey('Simba.' + Extension + '\shell\open\command', HKEY_CLASSES_ROOT, t)) then
Exit;
RegWriteString(t, '', '"' + App + '" "%1"');
RegCloseKey(t);
end;
Result := True;
end;
procedure UpdateAssociations;
var
s: string;
e: TStringArray;
i: Integer;
begin
s := GetExeName;
e := Explode(',', Extensions);
if (s <> '') and (Length(e) > 0) then
begin
for i := High(e) downto 0 do
if (not AssociateExtension(e[i], 'text', s)) then
Break;
if (i >= 0) then
WriteLn('Association failed!')
else
begin
SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, 0, 0);
WriteLn('Associations updated!');
end;
end;
end;
procedure OnClick(sender : TObject);
begin;
UpdateAssociations;
end;
procedure Init;
var
m: TMenuItem;
begin;
m := TMenuItem.Create(Simba_MainMenu);
m.Caption := '-';
Simba_MainMenu.Items.Items[4].Insert(Simba_MainMenu.Items.Items[4].Count - 2, m);
SimbaMenu := TMenuItem.Create(Simba_MainMenu);
SimbaMenu.Caption := 'Associate File Extensions';
SimbaMenu.OnClick := @OnClick;
Simba_MainMenu.Items.Items[4].Insert(Simba_MainMenu.Items.Items[4].Count - 2, SimbaMenu);
end;
procedure Free;
begin
end;
procedure Attach;
begin;
SimbaMenu.Visible := True;
end;
Procedure Detach;
begin
SimbaMenu.Visible := False;
end;
function GetName : string;
begin;
Result := 'Associate File Extensions (by Nielsie95)';
end;
function GetVersion : string;
begin;
result := '0.1';
end;
begin
end.

View File

@ -47,7 +47,7 @@ uses
colour_conv,dtmutil, colour_conv,dtmutil,
{$ifdef mswindows}windows, MMSystem,{$endif}//MMSystem -> Sounds {$ifdef mswindows}windows, MMSystem,{$endif}//MMSystem -> Sounds
uPSC_std, uPSC_controls,uPSC_classes,uPSC_graphics,uPSC_stdctrls,uPSC_forms, uPSC_menus, uPSC_std, uPSC_controls,uPSC_classes,uPSC_graphics,uPSC_stdctrls,uPSC_forms, uPSC_menus,
uPSC_extctrls, uPSC_mml, //Compile-libs uPSC_extctrls, uPSC_mml, uPSC_dll, //Compile-libs
uPSUtils, uPSUtils,
fontloader, fontloader,
IOmanager,//TTarget_Exported IOmanager,//TTarget_Exported
@ -55,7 +55,7 @@ uses
stringutil, //String st00f stringutil, //String st00f
uPSR_std, uPSR_controls,uPSR_classes,uPSR_graphics,uPSR_stdctrls,uPSR_forms, uPSR_mml, uPSR_std, uPSR_controls,uPSR_classes,uPSR_graphics,uPSR_stdctrls,uPSR_forms, uPSR_mml,
uPSR_menus, uPSI_ComCtrls, uPSI_Dialogs, uPSR_menus, uPSI_ComCtrls, uPSI_Dialogs, uPSR_dll,
files, files,
dialogs, dialogs,
dtm, //Dtms! dtm, //Dtms!
@ -258,6 +258,7 @@ begin
SIRegister_ComCtrls(x); SIRegister_ComCtrls(x);
SIRegister_Dialogs(x); SIRegister_Dialogs(x);
SIRegister_MML(x); SIRegister_MML(x);
RegisterDll_Compiletime(x);
with x.AddFunction('procedure writeln;').decl do with x.AddFunction('procedure writeln;').decl do
with AddParam do with AddParam do
@ -298,6 +299,7 @@ begin
RIRegister_Menus(x); RIRegister_Menus(x);
RIRegister_ComCtrls(x); RIRegister_ComCtrls(x);
RIRegister_Dialogs(x); RIRegister_Dialogs(x);
RegisterDLLRuntime(se);
RIRegister_MML(x); RIRegister_MML(x);
with x.FindClass('TMufasaBitmap') do with x.FindClass('TMufasaBitmap') do
begin begin

View File

@ -206,7 +206,7 @@ uses
colour_conv,dtmutil, colour_conv,dtmutil,
{$ifdef mswindows}windows, MMSystem,{$endif}//MMSystem -> Sounds {$ifdef mswindows}windows, MMSystem,{$endif}//MMSystem -> Sounds
uPSC_std, uPSC_controls,uPSC_classes,uPSC_graphics,uPSC_stdctrls,uPSC_forms, uPSC_menus, uPSC_std, uPSC_controls,uPSC_classes,uPSC_graphics,uPSC_stdctrls,uPSC_forms, uPSC_menus,
uPSC_extctrls, uPSC_mml, //Compile-libs uPSC_extctrls, uPSC_mml, uPSC_dll, //Compile-libs
uPSUtils, uPSUtils,
fontloader, fontloader,
IOmanager,//TTarget_Exported IOmanager,//TTarget_Exported
@ -214,7 +214,7 @@ uses
stringutil, //String st00f stringutil, //String st00f
uPSR_std, uPSR_controls,uPSR_classes,uPSR_graphics,uPSR_stdctrls,uPSR_forms, uPSR_mml, uPSR_std, uPSR_controls,uPSR_classes,uPSR_graphics,uPSR_stdctrls,uPSR_forms, uPSR_mml,
uPSR_menus, uPSI_ComCtrls, uPSI_Dialogs, uPSR_menus, uPSI_ComCtrls, uPSI_Dialogs, uPSR_dll,
files, files,
dialogs, dialogs,
dtm, //Dtms! dtm, //Dtms!
@ -519,7 +519,7 @@ begin
PSScript.OnCompile:= @OnCompile; PSScript.OnCompile:= @OnCompile;
PSScript.OnCompImport:= @OnCompImport; PSScript.OnCompImport:= @OnCompImport;
PSScript.OnExecImport:= @OnExecImport; PSScript.OnExecImport:= @OnExecImport;
PSScript.OnFindUnknownFile:=@PSScriptFindUnknownFile; PSScript.OnFindUnknownFile:= @PSScriptFindUnknownFile;
with PSScript do with PSScript do
begin begin
@ -641,6 +641,7 @@ begin
SIRegister_Menus(x); SIRegister_Menus(x);
SIRegister_ComCtrls(x); SIRegister_ComCtrls(x);
SIRegister_Dialogs(x); SIRegister_Dialogs(x);
RegisterDll_Compiletime(x);
with x do with x do
begin begin
@ -732,6 +733,7 @@ begin
RIRegister_Mufasa(x); RIRegister_Mufasa(x);
RIRegister_ComCtrls(x); RIRegister_ComCtrls(x);
RIRegister_Dialogs(x); RIRegister_Dialogs(x);
RegisterDLLRuntime(se);
se.RegisterFunctionName('WRITELN',@Writeln_,nil,nil); se.RegisterFunctionName('WRITELN',@Writeln_,nil,nil);
se.RegisterFunctionName('TOSTR',@ToStr_,nil,nil); se.RegisterFunctionName('TOSTR',@ToStr_,nil,nil);
se.RegisterFunctionName('SWAP',@swap_,nil,nil); se.RegisterFunctionName('SWAP',@swap_,nil,nil);