SRL Archive - Simba (Testing) Scripts

Hey there,

I quickly made an extension for easy file association using API calls (Windows only).

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.

The main reason I posted this was because I figured out something new today. The last time I was experimenting with API calls I stumbled upon pointers. PS can't handle them so it's hard to pass pointers to external functions. PChars seem to work nowadays, but there's still Integer/Byte/Record pointers that can be tricky. The solution I came up with are arrays :) Arrays are stored internally as pointers too, but PS actually can handle them. Another solution is "var". Pascal passes an in/out variable (var) as a pointer, so a: PInteger could be translated to var a: Integer (unless it returns an array).

For example,

procedure a(b: PInteger)

could be imported into PS as

procedure a(var b: Integer) or procedure a(b: TIntegerArray) (with b having a preset length of 1).

Some of you might have know this, but this post this for anyone who stumbles upon pointers in the future :) Also, this extension will only work with the git-version until the new update (688+).

Nielsie95

Nice! Yeah, I used that var trick to make PS pass the pointer.. PChars don't seem to work *that* good, for example you cannot pass a PChar as a variable :/. Well, you can.. But it results in nonsense, same goes for a PChar as a result in a function.


Also: Should we make something in extensions where it can export something like "Windows only"? So that linux users cannot enable this extension?

Yes, that would be useful :)
By the way, it looks like defines aren't working in extensions? Did I not export them properly?

From: nielsie95
Yes, that would be useful :)
By the way, it looks like defines aren't working in extensions? Did I not export them properly?

Defines look fine here? I just put everything in {$IFDEF Windows} and it still compiled :p.

Oh, you're right :smarty:
Don't know what went wrong then :p

This is from the Script Manager thread, but I'll answer it here again.

From: c0rrupt f1r3
I guess as in the scar button (under tools I think) that's quite simply: Associate .scar files d:

I've used quite a few scripts that have been SCAR intended, but work well with Simba as well… So, a cool little button, that way I don't have to look at a gay WINDOWS icon and rather a freakin lion? :D

If you want to associate the scar extension too, just edit the constant to:

const
  Extensions = 'simb,simba,sex,scar';

If you don't have this file in your extensions folder (associate.sex), create a new file and paste the above script in it and save. To enable the extension, open up Simba and open the View > Extensions form. Find associate.sex, click it and enable it. Now, in your tools menu, a new item should have appeared ("Associate File Extensions"). If you click it, it should associate all the appropriate files with Simba :)

[Error] (191:32): Unknown identifier 'Simba_MainMenu' at line 190
Compiling failed.

Is this supposed to be run in scar. cuz i formated it an tried in simba. Thanks for the help.

You should save it as an Extension and place it in Extensions/ (Do not forget to enable it too)
The installer will auto install this.

Thanks i got it working now i'm just running into SRL compiling issues but i got this one to work.

Incorporate into Simba already?

I think this is already distributed with Simba as a .sex..

E: http://git.villavu.com/?p=simba.git;a=tree;f=Extensions;h=89b5c1cf4785d8faa9bb1962c0ed63538d9e5e09;hb=2134e9a03159f4e535eb87ba819e82ddd113f364

It will be included with a new installer later.

The version in the repository of this extension now supports the Simba settings dialog to change the extensions to be associated (separate with a comma).

Default: "simb,simba,sex".
People who also want to associate SCAR files, can append ",scar" to it like this: "simb,simba,sex,scar".
If you also want to associate the temporary files of Simba: "simb,simba,sex,scar,crov".

A restart is required for the settings to take effect.

nielsie95, I added something too it and wanted too know if it fine too commit?

    if (not RegOpenKey('Simba.' + Extension + '\shell\Run', HKEY_CLASSES_ROOT, t)) then
      Exit;
    RegWriteString(t, '', 'Run in Simba');
    RegCloseKey(t);

    if (not RegOpenKey('Simba.' + Extension + '\shell\Run\command', HKEY_CLASSES_ROOT, t)) then
      Exit;
    RegWriteString(t, '', '"' + App + '" -o "%1" -r');
    RegCloseKey(t);

What does it do? If it adds something to the right-click menu, I propose an extra setting to let the user decide.

Yes it add "Run in Simba" to the rightclick menu that will open the script in simba and run it.

I'm fine with adding it, although I think the default value should be False. Personally, I wouldn't want that in my menu. :)

Also, there should be a way to remove this from your menu once you've added it (I think a setting check on the extension initialization should be fine).

http://paste.villavu.com/show/6512/

The DEF checks need to be played around with. It compiles with MAJOR1100.

From: Yago
http://paste.villavu.com/show/6512/

The DEF checks need to be played around with. It compiles with MAJOR1100.

I get this error as well - pretty sure everyone does, but it's at the very top of the debug and thus gets overlooked.

I'm not *quite* sure what it means or what it affects, afaik the SimbaInstaller.exe itself will associate files

This occurs because the extension checks if simbamajorversion = 1000. It should check if simbamajorversion >= 1000 or something of the like. I'm just wondering if there's an elegant way of doing this when defining types.

Edit:
https://github.com/MerlijnWajer/Simba/pull/336