Skip to content

Commit

Permalink
Synchronized with current C++ snapshot
Browse files Browse the repository at this point in the history 
Refactored FindText() - moved the repetitious code into nested procedure
Fixed MakeString() to not call StrLCopy for zero-length strings
Replaced $80000 with IMAGE_SCN_MEM_PRELOAD for segments
  • Loading branch information
tmcdos committed Jul 18, 2016
1 parent 6edc631 commit 998642e
Show file tree
Hide file tree
Showing 7 changed files with 193 additions and 249 deletions.
60 changes: 46 additions & 14 deletions Decompiler.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -121,7 +121,7 @@ TDecompiler = class
function DecompileGeneralCase(fromAdr, markAdr:Integer; loopInfo:TLoopInfo; Q:Integer): Integer;
Function DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TLoopInfo):Integer;
Function FGet(idx:Integer):PItem;
Procedure FPop;
function FPop: PITEM;
Procedure FPush(val:PITEM);
Procedure FSet(idx:Integer; val:PITEM);
Function GetArrayFieldOffset(ATypeName:AnsiString; AFromOfs, AScale:Integer):FieldInfo;
Expand Down Expand Up @@ -573,8 +573,9 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec)
FSet(0, val);
end;

Procedure TDecompiler.FPop;
Function TDecompiler.FPop:PITEM;
Begin
Result:=FGet(0);
_TOP_:=(_TOP_+1) and 7;
end;

Expand Down Expand Up @@ -2861,7 +2862,8 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec)
recN, recN1:InfoRec;
pCode:PPICODE;
de:TDecompiler;
_name, alias, line, retType, _value, iname, embAdr, _typeName, comment, regName:AnsiString;
_name, alias, line, retType, _value, iname, embAdr:AnsiString;
_typeName, comment, regName,propName:AnsiString;
Begin
idx:=-1;
pp := Nil;
Expand All @@ -2873,7 +2875,11 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec)
if IsValidCodeAdr(callAdr) then
Begin
recN := GetInfoRec(callAdr);
if recN.SameName('@AbstractError') then
_name:=recN.Name;
//Is it property function (Set, Get, Stored)?
if Pos('.',_name)<>0 then
propName := KBase.IsPropFunction(ExtractClassName(_name), ExtractProcName(_name));
if SameText(_name,'@AbstractError') then
Begin
Env.ErrAdr := curAdr;
raise Exception.Create('Pure Virtual Call');
Expand All @@ -2897,7 +2903,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec)
End;
End;
//@DispInvoke
if recN.SameName('@DispInvoke') then
if SameText(_name,'@DispInvoke') then
Begin
Env.AddToBody('DispInvoke(...);');
_value := ManualInput(CurProcAdr, curAdr, 'Input the number of RET bytes (in hex) of procedure at ' + Val2Str(curAdr,8), 'Bytes:');
Expand Down Expand Up @@ -3070,6 +3076,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec)
else line := _name;
End
else line := GetDefaultProcName(callAdr);
if propName <> '' then line:=line + '{' + propName + '}';
if methodKind = ikFunc then
Begin
while true do
Expand Down Expand Up @@ -7220,19 +7227,49 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL
Begin
GetRegItem(16, item1);
if IF_STACK_PTR in item1.Flags then
begin
Env.Stack[item1.IntValue]._Type := 'Variant';
line := Env.GetLvarName(item1.IntValue);
end;
GetRegItem(18, item2);
line := item1.Value + ' := Variant(' + item2.Value + ');';
line := line + ' := Variant(' + item2.Value + ');';
Env.AddToBody(line);
Exit;
End
else if SameText(name, '@VarFromTDateTime') then
Begin
GetRegItem(16, item1);
line := Env.GetLvarName(item1.IntValue) + ' := Variant(' + FGet(0).Value + ')';
if IF_STACK_PTR in item1.Flags then
begin
Env.Stack[item1.IntValue]._Type := 'Variant';
line := Env.GetLvarName(item1.IntValue);
end;
line:=line + ' := Variant(' + FPop.Value + ')'; //FGet(0)
Env.AddToBody(line);
FPop;
Exit;
end
else if SameText(name, '@VarFromReal') then
begin
GetRegItem(16, item1);
if IF_STACK_PTR in item1.Flags then
line := Env.GetLvarName(item1.IntValue);
line:=line + ' := Variant(' + FPop.Value + ')';
Env.AddToBody(line);
Exit;
end
else if SameText(name, '@VarToInt') then
begin
//eax=Variant, return Integer
GetRegItem(16, item1);
if IF_STACK_PTR in item1.Flags then
Env.Stack[item1.IntValue]._Type := 'Variant';
InitItem(@item);
item.Value := 'Integer(' + Env.GetLvarName(item1.IntValue) + ')';
SetRegItem(16, item);
line := 'EAX := ' + item.Value + ';';
Env.AddToBody(line);
Exit;
End
else if SameText(name, '@VarToInteger') then
Begin
Expand Down Expand Up @@ -7649,13 +7686,8 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL
Env.AddToBody(line);
Exit;
End;
//op st - do nothing
if DisaInfo.OpType[0] = otFST then
Begin
line := '// !!! - unknown situation';
Env.AddToBody(line);
Exit;
End;
//fstp - do nothing
if DisaInfo.OpType[0] = otFST then Exit;
End;
//fcom, fcomp, fcompp
_pos := Pos('fcom',DisaInfo.Mnem);
Expand Down
6 changes: 3 additions & 3 deletions Idr.dof
View file
Original file line number Diff line number Diff line change
Expand Up @@ -113,9 +113,9 @@ RootDir=C:\Program Files (x86)\Borland\Delphi7\Bin\
IncludeVerInfo=1
AutoIncBuild=0
MajorVer=1
MinorVer=0
MinorVer=1
Release=0
Build=1254
Build=1265
Debug=0
PreRelease=0
Special=0
Expand All @@ -126,7 +126,7 @@ CodePage=1251
[Version Info Keys]
CompanyName=
FileDescription=
FileVersion=1.0.0.1254
FileVersion=1.1.0.1265
InternalName=
LegalCopyright=
LegalTrademarks=
Expand Down
Binary file modified Idr.res
View file
Binary file not shown.
69 changes: 67 additions & 2 deletions KnowledgeBase.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -45,7 +45,7 @@ MKnowledgeBase = class
function GetTypeInfo(ATypeIdx:Integer; AFlags:TInfoFlagSet; out tInfo:MTypeInfo): Boolean; overload;
function GetVarInfo(AVarIdx:Integer; AFlags:TInfoFlagSet; Out vInfo:MVarInfo): Boolean;
function GetResStrInfo(AResStrIdx:Integer; AFlags:TInfoFlagSet; out rsInfo:MResStrInfo): Boolean;
function ScanCode(code:PAnsiChar;CodeFlags:PFlagArr; CodeSz:Integer; pInfo:PMProcInfo): Integer;
function ScanCode(code:PAnsiChar;var CodeFlags:array of TCflagSet; CodeSz:Integer; pInfo:PMProcInfo): Integer;
function GetModuleUses(ModuleID:Word): TWordDynArray;
function GetProcUses(ProcName:PAnsiChar; _Uses:TWordDynArray): Integer;
function GetTypeUses(TypeName:PAnsiChar): TWordDynArray;
Expand All @@ -57,6 +57,7 @@ MKnowledgeBase = class
function GetKBProcInfo(typeName:PAnsiChar; out procInfo:MProcInfo; Var procIdx:Integer): Boolean;
function GetKBTypeInfo(typeName:PAnsiChar; out typeInfo:MTypeInfo): Boolean;
function GetKBPropertyInfo(clasName:PAnsiChar; propName:AnsiString; out typeInfo:MTypeInfo): Boolean;
Function IsPropFunction (clasName, procName:AnsiString):AnsiString;
private
Inited:Boolean;
KBfile:TFileStream;
Expand Down Expand Up @@ -1184,7 +1185,7 @@ MKnowledgeBase = class
REsult:=true;
end;

Function MKnowledgeBase.ScanCode (code:PAnsiChar;CodeFlags:PFlagArr; CodeSz:Integer; pInfo:PMProcInfo):Integer;
Function MKnowledgeBase.ScanCode (code:PAnsiChar;var CodeFlags:array of TCflagSet; CodeSz:Integer; pInfo:PMProcInfo):Integer;
var
DumpSz:Integer;
Dump,Reloc:PAnsiChar;
Expand Down Expand Up @@ -1614,5 +1615,69 @@ MKnowledgeBase = class
end;
end;

Function MKnowledgeBase.IsPropFunction(clasName, procName:AnsiString):AnsiString;
var
n, idx:Integer;
p:PAnsiChar;
Len:Word;
use:TWordDynArray;
tInfo:MTypeInfo;
pname, _type, fname:AnsiString;
begin
use := GetTypeUses(PAnsiChar(clasName));
idx := GetTypeIdxByModuleIds(use, PAnsiChar(clasName));
use:=Nil;
if idx <> -1 then
begin
idx := TypeOffsets[idx].NamId;
if GetTypeInfo(idx, [INFO_PROPS], tInfo) then
begin
p := tInfo.Props;
for n := 0 to tInfo.PropsNum-1 do
begin
Inc(p);//Scope
Inc(p, 4);//Index
Inc(p, 4);//DispID
Len := PWord(p)^;
Inc(p, 2);
pname := MakeString(p, Len);
Inc(p, Len + 1);//Name
Len := PWord(p)^;
Inc(p, 2);
_type := TrimTypeName(MakeString(p, Len));
Inc(p, Len + 1);//TypeDef
Len := PWord(p)^;
Inc(p, 2);
fname := TrimTypeName(MakeString(p, Len));
Inc(p, Len + 1);//ReadName
if SameText(procName, fname) then
begin
Result:= pname;
Exit;
end;
Len := PWord(p)^;
Inc(p, 2);
fname := TrimTypeName(MakeString(p, Len));
Inc(p, Len + 1);//WriteName
if SameText(procName, fname) Then
begin
Result:= pname;
Exit;
end;
Len := PWord(p)^;
Inc(p, 2);
fname := TrimTypeName(MakeString(p, Len));
Inc(p, Len + 1);//StoredName
if SameText(procName, fname) Then
begin
Result:=pname;
Exit;
end;
end;
end;
End;
Result:='';
end;

End.

Loading

0 comments on commit 998642e

Please sign in to comment.