Parcourir la source

/LOG: Now logs DLL function imports.

Martijn Laan il y a 7 ans
Parent
commit
bf4b38edca
6 fichiers modifiés avec 100 ajouts et 26 suppressions
  1. 1 1
      Components/Ps
  2. 1 1
      Components/UniPs
  3. 15 1
      Projects/Main.pas
  4. 79 22
      Projects/ScriptRunner.pas
  5. 2 0
      Projects/Uninstall.pas
  6. 2 1
      whatsnew.htm

+ 1 - 1
Components/Ps

@@ -1 +1 @@
-Subproject commit 1720650e8aefd73df7ed1bce740ac814f5baa9de
+Subproject commit 1955b10a4056d94ef3b3c95ec91c1c4a55acf5ae

+ 1 - 1
Components/UniPs

@@ -1 +1 @@
-Subproject commit 4b310a0fe3905b8b1b6004a2891a8388a3fb3c1c
+Subproject commit 76e377efa5fddc55b3a6a3a3d944317bdfde4a12

+ 15 - 1
Projects/Main.pas

@@ -179,7 +179,9 @@ var
 {$ENDIF}
 
   CodeRunner: TScriptRunner;
-  
+
+procedure CodeRunnerOnLog(const S: String);
+procedure CodeRunnerOnLogFmt(const S: String; const Args: array of const);
 function CodeRunnerOnDebug(const Position: LongInt;
   var ContinueStepOver: Boolean): Boolean;
 function CodeRunnerOnDebugIntermediate(const Position: LongInt;
@@ -2038,6 +2040,16 @@ begin
   DebugNotify(Kind, Integer(OriginalEntryIndexes[EntryType][Number]), B);
 end;
 
+procedure CodeRunnerOnLog(const S: String);
+begin
+  Log(S);
+end;
+
+procedure CodeRunnerOnLogFmt(const S: String; const Args: array of const);
+begin
+  LogFmt(S, Args);
+end;
+
 procedure CodeRunnerOnDllImport(var DllName: String; var ForceDelayLoad: Boolean);
 var
   S, BaseName, FullName: String;
@@ -3141,6 +3153,8 @@ begin
   if SetupHeader.CompiledCodeText <> '' then begin
     CodeRunner := TScriptRunner.Create();
     try
+      CodeRunner.OnLog := CodeRunnerOnLog;
+      CodeRunner.OnLogFmt := CodeRunnerOnLogFmt;
       CodeRunner.OnDllImport := CodeRunnerOnDllImport;
       CodeRunner.OnDebug := CodeRunnerOnDebug;
       CodeRunner.OnDebugIntermediate := CodeRunnerOnDebugIntermediate;

+ 79 - 22
Projects/ScriptRunner.pas

@@ -17,6 +17,8 @@ uses
   uPSRuntime, uPSDebugger, uPSUtils;
 
 type
+  TScriptRunnerOnLog = procedure(const S: String);
+  TScriptRunnerOnLogFmt = procedure(const S: String; const Args: array of const);
   TScriptRunnerOnDllImport = procedure(var DllName: String; var ForceDelayLoad: Boolean);
   TScriptRunnerOnDebug = function(const Position: LongInt; var ContinueStepOver: Boolean): Boolean;
   TScriptRunnerOnDebugIntermediate = function(const Position: LongInt; var ContinueStepOver: Boolean): Boolean;
@@ -26,10 +28,14 @@ type
     private
       FPSExec: TPSDebugExec;
       FClassImporter: TPSRuntimeClassImporter;
+      FOnLog: TScriptRunnerOnLog;
+      FOnLogFmt: TScriptRunnerOnLogFmt;
       FOnDllImport: TScriptRunnerOnDllImport;
       FOnDebug: TScriptRunnerOnDebug;
       FOnDebugIntermediate: TScriptRunnerOnDebugIntermediate;
       FOnException: TScriptRunnerOnException;
+      procedure Log(const S: String);
+      procedure LogFmt(const S: String; const Args: array of const);
       procedure RaisePSExecException;
       procedure SetPSExecParameters(const Parameters: array of Const; Params: TPSList);
       procedure SetPSExecReturnValue(Params: TPSList; BaseType: TPSBaseType; var Res: PPSVariant);
@@ -44,6 +50,8 @@ type
       function RunIntegerFunction(const Name: AnsiString; const Parameters: array of Const; const MustExist: Boolean; const Default: Integer): Integer;
       function RunStringFunction(const Name: AnsiString; const Parameters: array of Const; const MustExist: Boolean; const Default: String): String;
       function EvaluateUsedVariable(const Param1, Param2, Param3: LongInt; const Param4: AnsiString): String;
+      property OnLog: TScriptRunnerOnLog read FOnLog write FOnLog;
+      property OnLogFmt: TScriptRunnerOnLogFmt read FOnLogFmt write FOnLogFmt;
       property OnDllImport: TScriptRunnerOnDllImport read FOnDllImport write FOnDllImport;
       property OnDebug: TScriptRunnerOnDebug read FOnDebug write FOnDebug;
       property OnDebugIntermediate: TScriptRunnerOnDebugIntermediate read FOnDebugIntermediate write FOnDebugIntermediate;
@@ -69,6 +77,18 @@ uses
   {$WARN IMPLICIT_STRING_CAST OFF}
 {$ENDIF}
 
+procedure TScriptRunner.Log(const S: String);
+begin
+  if Assigned(FOnLog) then
+    FOnLog(S);
+end;
+
+procedure TScriptRunner.LogFmt(const S: String; const Args: array of const);
+begin
+  if Assigned(FOnLogFmt) then
+    FOnLogFmt(S, Args);
+end;
+
 procedure TScriptRunner.ShowPSExecError(const Error: TPSError);
 begin
   raise Exception.Create('Script error: ' + PSErrorToString(Error, ''));
@@ -155,54 +175,74 @@ end;
 {---}
 
 {$IFDEF UNICODE}
-function EncodeDLLFilename(const Filename: String): AnsiString;
+function EncodeDLLFilenameForROPS(const Filename: String): AnsiString;
 begin
   Result := '';
   if Filename <> '' then
-    Result := AnsiString('<utf8>') + UTF8Encode(Filename);
+      Result := AnsiString('<utf8>') + UTF8Encode(Filename);
 end;
 
 function NewUnloadDLLProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;
 begin
-  UnloadDLL(Caller, EncodeDLLFilename(Stack.GetString(-1)));
+  UnloadDLL(Caller, EncodeDLLFilenameForROPS(Stack.GetString(-1)));
   Result := True;
 end;
 {$ENDIF}
 
 function PSExecOnSpecialProcImport(Sender: TPSExec; p: TPSExternalProcRec; Tag: Pointer): Boolean;
+const
+  SYesNo: array[Boolean] of String = ('No', 'Yes');
 var
   ScriptRunner: TScriptRunner;
-  DllName: AnsiString;
+  S, DllName, FunctionName: AnsiString;
 {$IFDEF UNICODE}
   UnicodeDllName: String;
 {$ENDIF}
   I: Integer;
-  ForceDelayLoad: Boolean;
+  ForceDelayLoad, DelayLoad: Boolean;
+  ErrorCode: LongInt;
 begin
   ScriptRunner := Sender.ID;
   ForceDelayLoad := False;
 
-  if Assigned(ScriptRunner.FOnDllImport) then begin
-    DllName := p.Decl;
+  ScriptRunner.Log('-- DLL function import --');
 
-    I := Pos(AnsiString('dll:'), DllName);
-    if I <> 1 then begin
-      Result := False;
-      Exit;
-    end;
-    Delete(DllName, 1, Length('dll:'));
+  S := p.Decl;
 
-    I := Pos(AnsiString(#0), DllName);
-    if I = 0 then begin
-      Result := False;
-      Exit;
-    end;
-    Delete(DllName, I, MaxInt);
+  I := Pos(AnsiString('dll:'), S);
+  if I <> 1 then begin
+    Result := False;
+    Exit;
+  end;
+  Delete(S, 1, Length('dll:'));
+
+  I := Pos(AnsiString(#0), S);
+  if I = 0 then begin
+    Result := False;
+    Exit;
+  end;
+  DllName := Copy(S, 1, I-1);
+  Delete(S, 1, I);
+
+  I := Pos(AnsiString(#0), S);
+  if I = 0 then begin
+    Result := False;
+    Exit;
+  end;
+  FunctionName := Copy(S, 1, I-1);
 
+  ScriptRunner.LogFmt('Function name: %s', [FunctionName]);
+{$IFDEF UNICODE}
+  UnicodeDllName := UTF8ToString(DllName);
+  ScriptRunner.LogFmt('DLL name: %s', [UnicodeDllname]);
+{$ELSE}
+  ScriptRunner.LogFmt('DLL name: %s', [DllName]);
+{$ENDIF}
+
+  if Assigned(ScriptRunner.FOnDllImport) then begin
 {$IFDEF UNICODE}
-    UnicodeDllName := UTF8ToString(DllName);
     ScriptRunner.FOnDllImport(UnicodeDllName, ForceDelayLoad);
-    DllName := EncodeDLLFilename(UnicodeDllName);
+    DllName := EncodeDLLFilenameForROPS(UnicodeDllName);
 {$ELSE}
     ScriptRunner.FOnDllImport(DllName, ForceDelayLoad);
 {$ENDIF}
@@ -210,7 +250,24 @@ begin
     p.Decl := AnsiString('dll:') + DllName + Copy(p.Decl, Pos(AnsiString(#0), p.Decl), MaxInt);
   end;
 
-  Result := ProcessDllImportEx(Sender, p, ForceDelayLoad);
+  if DllName <> '' then begin
+{$IFDEF UNICODE}
+    ScriptRunner.LogFmt('Dest DLL name: %s', [UnicodeDllName]);
+{$ELSE}
+    ScriptRunner.LogFmt('Dest DLL name: %s', [DllName]);
+{$ENDIF}
+    ScriptRunner.Log('Importing the DLL function.');
+  end else
+    ScriptRunner.Log('Skipping.'); { We're actually still going to call ProcessDllImport but this doesn't matter to the user. }
+
+  Result := ProcessDllImportEx2(Sender, p, ForceDelayLoad, DelayLoad, ErrorCode);
+
+  if DllName <> '' then begin
+    if Result then
+      ScriptRunner.LogFmt('Succesfully imported the DLL function. Delay loaded? %s', [SYesNo[DelayLoad]])
+    else
+      ScriptRunner.LogFmt('Failed to import the DLL function (%d).', [ErrorCode]);
+  end;
 end;
 
 procedure PSExecOnSourceLine(Sender: TPSDebugExec; const Name: AnsiString; Position, Row, Col: Cardinal);

+ 2 - 0
Projects/Uninstall.pas

@@ -589,6 +589,8 @@ begin
       AssignCustomMessages(Pointer(CompiledCodeData[6]), Length(CompiledCodeData[6])*SizeOf(CompiledCodeData[6][1]));
 
       CodeRunner := TScriptRunner.Create();
+      CodeRunner.OnLog := CodeRunnerOnLog;
+      CodeRunner.OnLogFmt := CodeRunnerOnLogFmt;
       CodeRunner.OnDllImport := CodeRunnerOnDllImport;
       CodeRunner.OnDebug := CodeRunnerOnDebug;
       CodeRunner.OnDebugIntermediate := CodeRunnerOnDebugIntermediate;

+ 2 - 1
whatsnew.htm

@@ -48,11 +48,12 @@ For conditions of distribution and use, see <a href="http://www.jrsoftware.org/f
 <ul>
   <li>Unicode Inno Setup: Unicode is now supported for the input source. For example, where before you had to write <tt>S := #$0100 + #$0101 + 'Aa';</tt> you can now write <tt>S := '&#x0100;&#x0101;Aa';</tt> directly. Also see the new <i>UnicodeExample1.iss</i> example script.</li>
   <li>Added new <tt>IsX86</tt>, <tt>IsX64</tt>, <tt>IsIA64</tt>, and <tt>IsARM64</tt> support functions.</li>
+  <li>/LOG: Now logs DLL function imports.</li>
 </ul>
 </li>
 <li>Any [Files] entries with the <tt>deleteafterinstall</tt> flag or with <tt>DestDir</tt> set to <tt>{tmp}</tt> or a subdirectory of <tt>{tmp}</tt> are no longer included in the <tt>EstimatedSize</tt> value in the Uninstall registry key.</li>
 <li><i>Fix:</i> In 5.5.9 it was no longer possible to include a drive colon in [Setup] section directive <tt>OutputManifestFile</tt>.</li>
-<li>Unicode [Code] based on RemObjects Pascal Script Git commit 4b310a0fe3905b8b1b6004a2891a8388a3fb3c1c.</li>
+<li>Unicode [Code] based on RemObjects Pascal Script Git commit 76e377efa5fddc55b3a6a3a3d944317bdfde4a12.</li>
 <li>Minor tweaks.</li>
 </ul>
 <p>Thanks to ElSanchez and DRON for their contributions for Unicode input source support and improved image stretching respectively. Thanks to KngStr for his proof of concept for ISPP compiler directive highlighting.<p>