diff --git a/Extensions/associate.sex b/Extensions/associate.sex new file mode 100644 index 0000000..4d3f5d1 --- /dev/null +++ b/Extensions/associate.sex @@ -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. diff --git a/Projects/Simba/psextension.pas b/Projects/Simba/psextension.pas index a3dc6d8..72be30a 100644 --- a/Projects/Simba/psextension.pas +++ b/Projects/Simba/psextension.pas @@ -47,7 +47,7 @@ uses colour_conv,dtmutil, {$ifdef mswindows}windows, MMSystem,{$endif}//MMSystem -> Sounds 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, fontloader, IOmanager,//TTarget_Exported @@ -55,7 +55,7 @@ uses stringutil, //String st00f 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, dialogs, dtm, //Dtms! @@ -258,6 +258,7 @@ begin SIRegister_ComCtrls(x); SIRegister_Dialogs(x); SIRegister_MML(x); + RegisterDll_Compiletime(x); with x.AddFunction('procedure writeln;').decl do with AddParam do @@ -298,6 +299,7 @@ begin RIRegister_Menus(x); RIRegister_ComCtrls(x); RIRegister_Dialogs(x); + RegisterDLLRuntime(se); RIRegister_MML(x); with x.FindClass('TMufasaBitmap') do begin diff --git a/Units/MMLAddon/mmlpsthread.pas b/Units/MMLAddon/mmlpsthread.pas index 0688bc9..577f9bb 100644 --- a/Units/MMLAddon/mmlpsthread.pas +++ b/Units/MMLAddon/mmlpsthread.pas @@ -206,7 +206,7 @@ uses colour_conv,dtmutil, {$ifdef mswindows}windows, MMSystem,{$endif}//MMSystem -> Sounds 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, fontloader, IOmanager,//TTarget_Exported @@ -214,7 +214,7 @@ uses stringutil, //String st00f 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, dialogs, dtm, //Dtms! @@ -519,7 +519,7 @@ begin PSScript.OnCompile:= @OnCompile; PSScript.OnCompImport:= @OnCompImport; PSScript.OnExecImport:= @OnExecImport; - PSScript.OnFindUnknownFile:=@PSScriptFindUnknownFile; + PSScript.OnFindUnknownFile:= @PSScriptFindUnknownFile; with PSScript do begin @@ -641,6 +641,7 @@ begin SIRegister_Menus(x); SIRegister_ComCtrls(x); SIRegister_Dialogs(x); + RegisterDll_Compiletime(x); with x do begin @@ -732,6 +733,7 @@ begin RIRegister_Mufasa(x); RIRegister_ComCtrls(x); RIRegister_Dialogs(x); + RegisterDLLRuntime(se); se.RegisterFunctionName('WRITELN',@Writeln_,nil,nil); se.RegisterFunctionName('TOSTR',@ToStr_,nil,nil); se.RegisterFunctionName('SWAP',@swap_,nil,nil);