From 18ed0f4e79502a0c370da0fb682bc6830c788fcc Mon Sep 17 00:00:00 2001 From: tmcdos Date: Fri, 14 Jul 2017 14:25:01 +0300 Subject: [PATCH] Synchronized to C++ version from April 1-st, 2017 --- Decompiler.pas | 1090 ++++++++++++++++++++++++++++------------- Def_decomp.pas | 17 +- Def_disasm.pas | 2 +- Def_know.pas | 20 +- Def_main.pas | 7 +- Def_thread.pas | 2 +- Disasm.pas | 2 +- EditFieldsDlg.pas | 2 +- EditFunctionDlg.dfm | 28 +- EditFunctionDlg.pas | 199 ++++++-- Heuristic.pas | 42 +- IDCGen.pas | 86 +++- IdcSplitSize.dfm | 55 +++ IdcSplitSize.pas | 57 +++ Idr.dof | 6 +- Idr.dpr | 4 +- Idr.res | Bin 8244 -> 8236 bytes Infos.pas | 141 +++++- KnowledgeBase.pas | 19 +- Main.dfm | 60 ++- Main.pas | 1131 ++++++++++++++++++++++++++----------------- Misc.pas | 467 +++++++++++++----- ProgressBar.dfm | 25 - Threads.pas | 110 +++-- TypeInfos.pas | 3 +- 25 files changed, 2458 insertions(+), 1117 deletions(-) create mode 100644 IdcSplitSize.dfm create mode 100644 IdcSplitSize.pas delete mode 100644 ProgressBar.dfm diff --git a/Decompiler.pas b/Decompiler.pas index a96fdbb..a4f6764 100644 --- a/Decompiler.pas +++ b/Decompiler.pas @@ -70,10 +70,10 @@ TDecompileEnv = class BJLlist:TList;//TBJL CmpStack:TList; Embedded:Boolean; // Is proc emebedded ? - //EmbeddedList:TStringList;//List of embedded procedures addresses + EmbeddedList:TStringList;//List of embedded procedures addresses constructor Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec); Destructor Destroy; Override; - Function GetLvarName(Ofs:Integer):AnsiString; + function GetLvarName(Ofs:Integer;Const _Type:AnsiString): AnsiString; Procedure AddToBody(src:AnsiString); Overload; Procedure AddToBody(src:TStringList); Overload; Function IsExitAtBodyEnd:Boolean; @@ -124,7 +124,8 @@ TDecompiler = class function FPop: PITEM; Procedure FPush(val:PITEM); Procedure FSet(idx:Integer; val:PITEM); - Function GetArrayFieldOffset(ATypeName:AnsiString; AFromOfs, AScale:Integer):FieldInfo; + Procedure FXch(idx1,idx2:Integer); + function GetArrayFieldOffset(ATypeName:AnsiString; AFromOfs, AScale:Integer;var _name,_type:AnsiString): Integer; Function GetCmpInfo(fromAdr:Integer):Integer; Function GetCycleFrom:AnsiString; Procedure GetCycleIdx(IdxInfo:PIdxInfo; ADisInfo:TDisInfo); @@ -147,7 +148,7 @@ TDecompiler = class procedure SetRegItem(Idx:Integer; var val:TITEM); Procedure SetStop(Adr:Integer); function SimulateCall(curAdr, callAdr:Integer; instrLen:Integer; mtd:PMethodRec; AClassAdr:Integer): Boolean; - Procedure SimulateFloatInstruction(curAdr:Integer; instrLen:Integer); + procedure SimulateFloatInstruction(curAdr:Integer); Procedure SimulateFormatCall; Procedure SimulateInherited(procAdr:Integer); Procedure SimulateInstr1(curAdr:Integer; Op:Byte); @@ -159,9 +160,9 @@ TDecompiler = class Procedure SimulateInstr2MemReg(curAdr:Integer; Op:Byte); Procedure SimulateInstr3(curAdr:Integer; Op:Byte); Procedure SimulatePop(curAdr:Integer); - Procedure SimulatePush(curAdr:Integer); + Procedure SimulatePush(curAdr:Integer;bShowComment:Boolean); Function SimulateSysCall(name:AnsiString; procAdr:Integer; instrLen:Integer):Boolean; - Function AnalyzeConditions(brType:Integer; curAdr, sAdr, jAdr:Integer; loopInfo:TLoopInfo):Integer; + Function AnalyzeConditions(brType:Integer; curAdr, sAdr, jAdr:Integer; loopInfo:TLoopInfo;bFloat:Boolean):Integer; end; Implementation @@ -328,7 +329,11 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) bjllist := TList.Create; CmpStack := TList.Create; Embedded := PF_EMBED in recN.procInfo.flags; - //EmbeddedList := TStringList.Create; + EmbeddedList := TStringList.Create; + BpBased := PF_BPBASED in recN.procInfo.flags; + LocBase := 0; + if not BpBased then LocBase := StackSize; + LastResString := ''; end; Destructor TDecompileEnv.Destroy; @@ -340,13 +345,36 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) BJLseq.Free; BJLlist.Free; CmpStack.Free; - //EmbeddedList.Free; + EmbeddedList.Free; Inherited; end; -Function TDecompileEnv.GetLvarName (Ofs:Integer):AnsiString; +Function TDecompileEnv.GetLvarName (Ofs:Integer;Const _Type:AnsiString):AnsiString; +Var + locInfo:PLocalInfo; + _recN:InfoRec; + n:Integer; Begin Result:='lvar_' + Val2Str(LocBase - Ofs); + //Insert by ZGL + _recN := GetInfoRec(StartAdr); + if Assigned(_recN) and Assigned(_recN.procInfo) then + begin + if Assigned(_recN.procInfo.locals) then + begin + for n := 0 to _recN.procInfo.locals.Count-1 do + begin + locInfo := _recN.procInfo.locals[n]; + if (locInfo.Ofs = Ofs) and (locInfo.Name <> '') Then //LocBase - Ofs + Begin + Result:=locInfo.Name; + Exit; + end; + end; + end; + locInfo := _recN.procInfo.AddLocal(Ofs, 1, Result, _Type); + end; + //////////////// end; Function TDecompileEnv.GetContext (Adr:Integer):PDContext; @@ -521,6 +549,8 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) Raise Exception.Create('Attempt to PUSH on full Stack!'); end; Dec(_ESP_, 4); + Env.Stack[_ESP_]:=item^; + { With Env.Stack[_ESP_] do Begin Flags := Item.Flags; @@ -532,6 +562,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) _Type := Item._Type; Name := Item.Name; end; + } end; Function TDecompiler.Pop:PItem; @@ -554,6 +585,8 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) //Save val into ST(idx) Procedure TDecompiler.FSet (idx:Integer; val:PITEM); Begin + Env.FStack[(_TOP_ + idx) and 7] := val^; + { With Env.FStack[(_TOP_ + idx) and 7] do Begin Flags := val.Flags; @@ -565,8 +598,51 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) _Type := val._Type; Name := val.Name; End; + } end; +//Xchange ST(idx1) and ST(idx2) +Procedure TDecompiler.FXch(idx1, idx2:Integer); +var + tmp:TItem; + item1,item2:PItem; +begin + item1 := FGet(idx1); + item2 := FGet(idx2); + + tmp:=item1^; + item1^:=item2^; + item2^:=tmp; + { + tmp.Flags = _item1->Flags; + tmp.Precedence = _item1->Precedence; + tmp.Size = _item1->Size; + tmp.Offset = _item1->Offset; + tmp.IntValue = _item1->IntValue; + tmp.Value = _item1->Value; + tmp.Type = _item1->Type; + tmp.Name = _item1->Name; + + _item1->Flags = _item2->Flags; + _item1->Precedence = _item2->Precedence; + _item1->Size = _item2->Size; + _item1->Offset = _item2->Offset; + _item1->IntValue = _item2->IntValue; + _item1->Value = _item2->Value; + _item1->Type = _item2->Type; + _item1->Name = _item2->Name; + + _item2->Flags = _tmp.Flags; + _item2->Precedence = _tmp.Precedence; + _item2->Size = _tmp.Size; + _item2->Offset = _tmp.Offset; + _item2->IntValue = _tmp.IntValue; + _item2->Value = _tmp.Value; + _item2->Type = _tmp.Type; + _item2->Name = _tmp.Name; + } +end; + Procedure TDecompiler.FPush (val:PITEM); Begin _TOP_:=(_TOP_-1) and 7; @@ -598,6 +674,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) Function TDecompiler.Init (fromAdr:Integer):Boolean; var + kind:LKind; retKind:LKind; callKind:Byte; n, argNum, ndx, rn, size:Integer; @@ -605,7 +682,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) recN:InfoRec; aInfo:PArgInfo; item:TItem; - retType:AnsiString; + retType,typeDef:AnsiString; Begin Result:=True; retKind:=ikUnknown; @@ -647,10 +724,11 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) InitItem(@item); item.Flags := [IF_ARG]; if aInfo.Tag = $22 then Include(item.Flags, IF_VAR); + kind:=GetTypeKind(aInfo.TypeDef,size); item._Type := aInfo.TypeDef; item.Name := GetArgName(aInfo); item.Value := item.Name; - if aInfo.Size > 4 then + if (kind=ikFloat) and (aInfo.Tag <> $22) then Begin size := aInfo.Size; while size<>0 do @@ -719,10 +797,12 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) //Push ret address InitItem(@item); Push(@item); + { removed by Crypto Env.BpBased := PF_BPBASED in recN.procInfo.flags; Env.LocBase := 0; if not Env.BpBased then Env.LocBase := _ESP_; Env.LastResString := ''; + } end; Procedure TDecompileEnv.OutputSourceCodeLine (line:AnsiString); @@ -783,13 +863,15 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) var de:TDecompiler; recN:InfoRec; + locInfo:PLocalInfo; + n:Integer; Begin //EmbeddedList.Clear; De := TDecompiler.Create(Self); try if not De.Init(StartAdr) then begin - De.Env.ErrAdr := De.Env.StartAdr; + De.Env.ErrAdr := {De.Env.}StartAdr; Raise Exception.Create('Procedure Prototype is not completed'); end; De.InitFlags; @@ -798,6 +880,27 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) recN := GetInfoRec(StartAdr); ProcName := recN.Name; AddToBody(recN.MakePrototype(StartAdr, true, false, false, true, false)); + + //add vars -- Insert by ZGL + if Assigned(recN.procInfo.locals) and (recN.procInfo.locals.Count > 0) then + begin + for n := 0 to recN.procInfo.locals.Count-1 do + begin + locInfo := recN.procInfo.locals[n]; + GetLvarName(locInfo.Ofs, locInfo.TypeDef); + End; + end; + if Assigned(recN.procInfo.locals) and (recN.procInfo.locals.Count > 0) then + begin + AddToBody('var'); + for n := 0 to recN.procInfo.locals.Count-1 do + begin + locInfo := recN.procInfo.locals[n]; + AddToBody(' ' + GetLvarName(locInfo.Ofs, locInfo.TypeDef) + ':' + locInfo.TypeDef + ';'); + end; + end; + /////////////////////////// + AddToBody('begin'); if StartAdr <> EP then begin @@ -1443,12 +1546,36 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) //@TryFinallyExit if IsFlagSet([cfFinallyExit], curPos) then Begin - Env.AddToBody('Exit;'); - while IsFlagSet([cfFinallyExit], curPos) do + _pos := curPos; + adr := curAdr; + num := 0; + while IsFlagSet([cfFinallyExit], _pos) do Begin - Inc(curPos); - Inc(curAdr); + ClearFlag([cfFinallyExit], _pos); //to avoid infinity recursion + Inc(_Pos); + Inc(Adr); + Inc(num); + End; + de := TDecompiler.Create(Env); + de.SetStackPointers(Self); + de.SetDeFlags(DeFlags); + de.SetStop(adr); + try + curAdr := de.Decompile(curAdr, [], Nil); + //Env.AddToBody('Exit;'); + Except + on e:Exception do + begin + de.free; + raise Exception('FinallyExit->' + e.Message); + end; End; + de.free; + + SetFlags([cfFinallyExit], curPos, num); //restore flags + curPos := _pos; + curAdr := adr; + continue; End; //Try @@ -1510,7 +1637,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) Inc(adr, instrLen); instrLen := frmDisasm.Disassemble(Code + _pos, adr, @disInfo, Nil); branchAdr := disInfo.Immediate; - //Save position + //Save position and address sPos := _pos + instrLen; sAdr := adr + instrLen; for n := 0 to num-1 do @@ -1522,7 +1649,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) if _pos = decPos then break; instrLen := frmDisasm.Disassemble(Code + _pos, adr, @DisaInfo, Nil); op := frmDisasm.GetOp(DisaInfo.Mnem); - if op = OP_PUSH then SimulatePush(adr); + if op = OP_PUSH then SimulatePush(adr,true); if (op = OP_ADD) or (op = OP_SUB) then SimulateInstr2(adr, op); Inc(_pos, instrLen); Inc(adr, instrLen); @@ -1569,7 +1696,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) line:=line + GetDecompilerRegisterName(varIdx); //local var if _loopInfo.forInfo.CntInfo.IdxType = itLVAR then - line:=line + Env.GetLvarName(varIdx); + line:=line + Env.GetLvarName(varIdx,'Integer'); End else Begin @@ -1579,7 +1706,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) line:=line + GetDecompilerRegisterName(varIdx); //local var if _loopInfo.forInfo.VarInfo.IdxType = itLVAR then - line:=line + Env.GetLvarName(varIdx); + line:=line + Env.GetLvarName(varIdx,'Integer'); End; line:=line + ' := ' + _loopInfo.forInfo.From + ' '; if _loopInfo.forInfo.Down then line:=line + 'down'; @@ -1885,7 +2012,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) brType := BranchGetPrevInstructionType(CmpAdr, jmpAdr, loopInfo); //Skip conditional branch Inc(curAdr, instrLen); - curAdr := AnalyzeConditions(brType, curAdr, sAdr, jmpAdr, loopInfo); + curAdr := AnalyzeConditions(brType, curAdr, sAdr, jmpAdr, loopInfo, disInfo.Float); curPos := Adr2Pos(curAdr); continue; End @@ -1928,23 +2055,23 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) bytesToSkip2 := IsInt64ComparisonViaStack2(curAdr, skip1, skip2, endAdr); if bytesToSkip1 + bytesToSkip2 = 0 then Begin - SimulatePush(curAdr); + SimulatePush(curAdr,Not IsFlagSet([cfFrame],curPos)); Inc(curPos, instrLen); Inc(curAdr, instrLen); End else Begin - //Save position + //Save position and address sPos := curPos; sAdr := curAdr; //Simulate push instrLen := frmDisasm.Disassemble(Code + curPos, curAdr, @DisaInfo, Nil); - SimulatePush(curAdr); - Inc(curPos, instrLen); + SimulatePush(curAdr,true); + Inc(curPos, instrLen); Inc(curAdr, instrLen); instrLen := frmDisasm.Disassemble(Code + curPos, curAdr, @DisaInfo, Nil); - SimulatePush(curAdr); + SimulatePush(curAdr,true); Inc(curPos, instrLen); Inc(curAdr, instrLen); @@ -2009,7 +2136,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) brType := BranchGetPrevInstructionType(CmpAdr, jmpAdr, loopInfo); //Skip conditional branch Inc(curAdr, instrLen); - curAdr := AnalyzeConditions(brType, curAdr, sAdr, jmpAdr, loopInfo); + curAdr := AnalyzeConditions(brType, curAdr, sAdr, jmpAdr, loopInfo, disInfo.Float); curPos := Adr2Pos(curAdr); End; End; @@ -2031,7 +2158,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) End else if (op = OP_CMP) or (DisaInfo.Float and (dd = 'fcom')) then Begin - //Save position + //Save position and address sPos := curPos; sAdr := curAdr; bytesToSkip := IsBoundErr(curAdr); @@ -2170,10 +2297,10 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) Inc(curAdr, instrLen); End; cmpRes := GetCmpInfo(curAdr); - //SimulateFloatInstruction(_sAdr, _instrLen); + //SimulateFloatInstruction(_sAdr{, _instrLen}); if CF_BJL in flags then Begin - SimulateFloatInstruction(sAdr, instrLen); + SimulateFloatInstruction(sAdr{, instrLen}); New(cmpItem); cmpItem.L := CompInfo.L; cmpItem.O := CompInfo.O; @@ -2191,17 +2318,17 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) //jcc up if disInfo.Immediate < curAdr then Begin - //if (DisInfo.Float) SimulateFloatInstruction(_sAdr, _instrLen); + if DisInfo.Float then SimulateFloatInstruction(sAdr{, instrLen}); line := 'if (' + CompInfo.L + ' ' + GetDirectCondition(CompInfo.O) + ' ' + CompInfo.R + ') then Continue;'; Env.AddToBody(line); - Inc(curPos, instrLen); + Inc(curPos, instrLen); Inc(curAdr, instrLen); continue; End; //jcc at BreakAdr if Assigned(loopInfo) and (loopInfo.BreakAdr = disInfo.Immediate) then Begin - //if (DisInfo.Float) SimulateFloatInstruction(_sAdr, _instrLen); + if DisInfo.Float then SimulateFloatInstruction(sAdr{, instrLen}); line := 'if (' + CompInfo.L + ' ' + GetDirectCondition(CompInfo.O) + ' ' + CompInfo.R + ') then Break;'; Env.AddToBody(line); Inc(curPos, instrLen); @@ -2220,7 +2347,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) brType := BranchGetPrevInstructionType(CmpAdr, jmpAdr, loopInfo); //Skip conditional branch Inc(curAdr, instrLen); - curAdr := AnalyzeConditions(brType, curAdr, sAdr, jmpAdr, loopInfo); + curAdr := AnalyzeConditions(brType, curAdr, sAdr, jmpAdr, loopInfo, disInfo.Float); curPos := Adr2Pos(curAdr); continue; End @@ -2235,7 +2362,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) End else if (op = OP_TEST) or (op = OP_BT) then Begin - //Save position + //Save address sAdr := curAdr; bytesToSkip := IsInlineLengthTest(curAdr); if bytesToSkip<>0 then @@ -2321,7 +2448,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) //Skip conditional branch Inc(curAdr, instrLen); - curAdr := AnalyzeConditions(brType, curAdr, sAdr, jmpAdr, loopInfo); + curAdr := AnalyzeConditions(brType, curAdr, sAdr, jmpAdr, loopInfo, disInfo.Float); curPos := Adr2Pos(curAdr); continue; End @@ -2382,7 +2509,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) End else if op = OP_SUB then Begin - //Save position + //Save address sAdr := curAdr; bytesToSkip := IsIntOver(curAdr + instrLen); endAdr := IsGeneralCase(curAdr, Env.StartAdr + Env.Size); @@ -2446,7 +2573,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) //Skip conditional branch instrLen := frmDisasm.Disassemble(Code + curPos, curAdr, Nil, Nil); Inc(curAdr, instrLen); - curAdr := AnalyzeConditions(brType, curAdr, sAdr, jmpAdr, loopInfo); + curAdr := AnalyzeConditions(brType, curAdr, sAdr, jmpAdr, loopInfo, disInfo.Float); curPos := Adr2Pos(curAdr); continue; End @@ -2501,7 +2628,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) //Skip conditional branch instrLen := frmDisasm.Disassemble(Code + curPos, curAdr, Nil, Nil); Inc(curAdr, instrLen); - curAdr := AnalyzeConditions(brType, curAdr, sAdr, jmpAdr, loopInfo); + curAdr := AnalyzeConditions(brType, curAdr, sAdr, jmpAdr, loopInfo, disInfo.Float); curPos := Adr2Pos(curAdr); continue; End @@ -2541,7 +2668,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) //Skip conditional branch instrLen := frmDisasm.Disassemble(Code + curPos, curAdr, Nil, Nil); Inc(curAdr, instrLen); - curAdr := AnalyzeConditions(brType, curAdr, sAdr, jmpAdr, loopInfo); + curAdr := AnalyzeConditions(brType, curAdr, sAdr, jmpAdr, loopInfo, disInfo.Float); curPos := Adr2Pos(curAdr); continue; End @@ -2612,6 +2739,8 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) End else if (op = OP_INC) or (op = OP_DEC) then Begin + // save address + sAdr:= curAdr; endAdr := IsGeneralCase(curAdr, Env.StartAdr + Env.Size); if endAdr<>0 then Begin @@ -2655,7 +2784,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) //Skip conditional branch instrLen := frmDisasm.Disassemble(Code + curPos, curAdr, Nil, Nil); Inc(curAdr, instrLen); - curAdr := AnalyzeConditions(brType, curAdr, sAdr, jmpAdr, loopInfo); + curAdr := AnalyzeConditions(brType, curAdr, sAdr, jmpAdr, loopInfo, disInfo.Float); curPos := Adr2Pos(curAdr); continue; End @@ -2768,7 +2897,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) Inc(r, elSize); End; End; - Env.AddToBody(Env.GetLvarName(item1.IntValue) + ' := ' + item2.Value + ';'); + Env.AddToBody(Env.GetLvarName(item1.IntValue,typeName) + ' := ' + item2.Value + ';'); Inc(curPos, instrLen); Inc(curAdr, instrLen); continue; @@ -2821,7 +2950,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) Inc(r, elSize); End; End; - Env.AddToBody(item1.Value + ' := ' + Env.GetLvarName(item2.IntValue) + ';'); + Env.AddToBody(item1.Value + ' := ' + Env.GetLvarName(item2.IntValue,typeName) + ';'); Inc(curPos, instrLen); Inc(curAdr, instrLen); continue; @@ -2839,7 +2968,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) End; if DisaInfo.Float then Begin - SimulateFloatInstruction(curAdr, instrLen); + SimulateFloatInstruction(curAdr{, instrLen}); Inc(curPos, instrLen); Inc(curAdr, instrLen); continue; @@ -2857,14 +2986,14 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) Function TDecompiler.SimulateCall (curAdr, callAdr:Integer; instrLen:Integer; mtd:PMethodRec; AClassAdr:Integer):Boolean; var - sep, fromKB, _vmt:Boolean; + sep, fromKB, _vmt,savedBpBase:Boolean; callKind:Byte; kind, retKind, methodKind:LKind; pp:PAnsiChar; savedIdx,savedStartAdr,savedLocBase,savedSize:Integer; argsNum, retBytes, retBytesCalc, len, _val, _esp:Integer; r,n,idx, rn, ndx, ss, _pos, _size, recsize:Integer; - classAdr, adr, dynAdr, vmtAdr:Integer; + classAdr, adr, dynAdr:Integer; item, item1:TItem; aInfo:PArgInfo; fInfo:FieldInfo; @@ -2873,8 +3002,8 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) recN, recN1:InfoRec; pCode:PPICODE; de:TDecompiler; - _name, alias, line, retType, _value, iname, embAdr:AnsiString; - _typeName, comment, regName,propName:AnsiString; + _name, _type, alias, line, retType, _value, iname, embAdr:AnsiString; + _typeName, comment, regName,propName, varName:AnsiString; Begin idx:=-1; pp := Nil; @@ -2940,23 +3069,23 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) retBytes := recN.procInfo.retBytes; //stdcall, pascal, cdecl - return bytes := 4 * ArgsNum if (callKind in [1..3]) and (retBytes=0) then retBytes := argsNum * 4; - (* - if (recN.procInfo.flags and PF_EMBED)<>0 then + + if PF_EMBED in recN.procInfo.flags then Begin - _embAdr := Val2Str(callAdr,8); - if Env.EmbeddedList.IndexOf(_embAdr) = -1 then + embAdr := Val2Str(callAdr,8); + if Env.EmbeddedList.IndexOf(embAdr) = -1 then Begin - Env.EmbeddedList.Add(_embAdr); - _savedIdx := FMain.lbCode.ItemIndex; + Env.EmbeddedList.Add(embAdr); + savedIdx := FMain.lbCode.ItemIndex; FMain.lbCode.ItemIndex := -1; - if Application.MessageBox(PAnsiChar('Decompile embedded procedure at address ' + _embAdr + '?'), 'Confirmation', MB_YESNO) = IDYES then + if Application.MessageBox(PAnsiChar('Decompile embedded procedure at address ' + embAdr + '?'), 'Confirmation', MB_YESNO) = IDYES then Begin - Env.AddToBody('//BEGIN_EMBEDDED_' + _embAdr); + Env.AddToBody('//BEGIN_EMBEDDED_' + embAdr); Env.AddToBody(recN.MakePrototype(callAdr, true, false, false, true, false)); - _savedStartAdr := Env.StartAdr; - _savedBpBased := Env.BpBased; - _savedLocBase := Env.LocBase; - _savedSize := Env.Size; + savedStartAdr := Env.StartAdr; + savedBpBase := Env.BpBased; + savedLocBase := Env.LocBase; + savedSize := Env.Size; Env.StartAdr := callAdr; _size := GetProcSize(callAdr); Env.Size := _size; @@ -2966,9 +3095,9 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) de.SetStop(callAdr + _size); try Env.AddToBody('begin'); - de.Decompile(callAdr, 0, Nil); + de.Decompile(callAdr, [], Nil); Env.AddToBody('end'); - Env.AddToBody('//END_EMBEDDED_' + _embAdr); + Env.AddToBody('//END_EMBEDDED_' + embAdr); except on E:Exception do Begin @@ -2978,15 +3107,14 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) end; Inc(_ESP_, 4); de.Free; - Env.StartAdr := _savedStartAdr; - Env.Size := _savedSize; - Env.BpBased := _savedBpBased; - Env.LocBase := _savedLocBase; + Env.StartAdr := savedStartAdr; + Env.Size := savedSize; + Env.BpBased := savedBpBase; + Env.LocBase := savedLocBase; End; - FMain.lbCode.ItemIndex := _savedIdx; + FMain.lbCode.ItemIndex := savedIdx; End; End; - *) End else Begin @@ -3130,6 +3258,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) rn := -1; regName := ''; kind := GetTypeKind(aInfo.TypeDef, _size); + if kind=ikFloat then _size:=aInfo.Size else _size:=4; if aInfo.Tag = $22 then _size := 4; //else _size := _argInfo.Size; if callKind = 0 then //fastcall @@ -3149,7 +3278,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) continue; End; End; - if _size >= 8 then + if (kind=ikFloat)and(aInfo.Tag<>$22) then Begin Dec(_esp, _size); item := Env.Stack[_esp]; @@ -3225,20 +3354,23 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) item1 := Env.Stack[item.IntValue]; if kind = ikInteger then Begin - line:=line + Env.GetLvarName(item.IntValue); - Env.Stack[item.IntValue].Value := Env.GetLvarName(item.IntValue); + varName:=Env.GetLvarName(item.IntValue,aInfo.TypeDef); + line:=line +varName; + Env.Stack[item.IntValue].Value := varName; continue; End else if kind = ikEnumeration then Begin - line:=line + Env.GetLvarName(item.IntValue); - Env.Stack[item.IntValue].Value := Env.GetLvarName(item.IntValue); + varName:=Env.GetLvarName(item.IntValue,aInfo.TypeDef); + line:=line +varName; + Env.Stack[item.IntValue].Value := varName; continue; End else if (kind = ikLString) or (kind = ikVariant) then Begin - line:=line + Env.GetLvarName(item.IntValue); - Env.Stack[item.IntValue].Value := Env.GetLvarName(item.IntValue); + varName:=Env.GetLvarName(item.IntValue,aInfo.TypeDef); + line:=line + varName; + Env.Stack[item.IntValue].Value := varName; Env.Stack[item.IntValue]._Type := aInfo.TypeDef; continue; End @@ -3249,12 +3381,12 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) End else if kind = ikArray then Begin - line:=line + Env.GetLvarName(item.IntValue); + line:=line + Env.GetLvarName(item.IntValue,aInfo.TypeDef); continue; End else if kind = ikRecord then Begin - line:=line + Env.GetLvarName(item.IntValue); + line:=line + Env.GetLvarName(item.IntValue,aInfo.TypeDef); recsize := GetRecordSize(aInfo.TypeDef); for r := 0 to recsize-1 do Begin @@ -3273,8 +3405,9 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) continue; End; //Type not found - line:=line + Env.GetLvarName(item.IntValue); - Env.Stack[item.IntValue].Value := Env.GetLvarName(item.IntValue); + varName:=Env.GetLvarName(item.IntValue,aInfo.TypeDef); + line:=line + varName; + Env.Stack[item.IntValue].Value := varName; Env.Stack[item.IntValue]._Type := aInfo.TypeDef; continue; End; @@ -3350,7 +3483,8 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) End else if kind = ikRecord then Begin - line:=line + item.Value; //ExtractClassName(_item.Value); + if _size < 8 Then line:=line + item.Value //ExtractClassName(_item.Value); + Else line:=line + item1.Value; continue; End else if kind = ikFloat then @@ -3464,7 +3598,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) else if item.Value <> '' then line := item.Value + ' := ' + line else - line := Env.GetLvarName(item.IntValue) + ' := ' + line; + line := Env.GetLvarName(item.IntValue,retType) + ' := ' + line; if retKind = ikRecord then Begin _size := GetRecordSize(retType); @@ -3548,7 +3682,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) if DisaInfo.BaseReg = 20 then Begin item := Env.Stack[_ESP_ + DisaInfo.Offset]; - line := Env.GetLvarName(_ESP_ + DisaInfo.Offset) + '(...);'; + line := Env.GetLvarName(_ESP_ + DisaInfo.Offset,'') + '(...);'; Env.AddToBody(line); _value := ManualInput(CurProcAdr, curAdr, 'Enter number of RET bytes (in hex) of procedure at ' + Val2Str(curAdr,8), 'Bytes:'); if _value = '' then @@ -3604,8 +3738,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) Exit; End; //Field - fInfo := FMain.GetField(item._Type, DisaInfo.Offset, _vmt, vmtAdr); - if fInfo=Nil then + if GetField(item._Type, DisaInfo.Offset, _name, _type)=0 then Begin while recM=Nil do Begin @@ -3632,8 +3765,8 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) End else Begin - if fInfo.Name <> '' then - Env.AddToBody(fInfo.Name + '(...);') + if _name <> '' then + Env.AddToBody(_name + '(...);') else Env.AddToBody('f' + Val2Str(DisaInfo.Offset) + '(...);'); _value := ManualInput(CurProcAdr, curAdr, 'Enter number of RET bytes (in hex) of procedure at ' + Val2Str(curAdr,8), 'Bytes:'); @@ -3670,18 +3803,41 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) Begin GetRegItem(DisaInfo.OpRegIdx[0], item); line := item.Value + ';'; - Env.AddToBody(line); - _value := ManualInput(CurProcAdr, curAdr, 'Enter number of RET bytes (in hex) of procedure at ' + Val2Str(curAdr,8), 'Bytes:'); + Env.AddToBody('call ...;'); + _value := ManualInput(CurProcAdr, curAdr, 'Enter number of stack arguments for procedure at ' + Val2Str(curAdr,8), 'NumArgs:'); if _value = '' then Begin Env.ErrAdr := curAdr; raise Exception.Create('Emptry input - See you later!'); End; - sscanf(PAnsiChar(_value),'%lX',[@retBytes]); - Inc(_ESP_, retBytes); + sscanf(PAnsiChar(_value),'%d',[@argsNum]); + Inc(_ESP_, 4*argsNum); Result:=false; Exit; End; + //call [reg+N] + if (DisaInfo.OpNum = 1) and (DisaInfo.OpType[0] = otMEM) then + begin + Env.AddToBody('call('); + _value := ManualInput(CurProcAdr, curAdr, 'Enter number of stack arguments for procedure at ' + Val2Str(curAdr,8), 'NumArgs:'); + if _value = '' then + begin + Env.ErrAdr := curAdr; + raise Exception.Create('Emptry input - See you later!'); + end; + sscanf(PAnsiChar(_value),'%d',[@argsNum]); + while argsNum<>0 do + begin + item := Env.Stack[_ESP_]; + if IF_INTVAL in item.Flags then Env.AddToBody(IntToStr(item.IntValue)) + else Env.AddToBody(item.Value); + Inc(_ESP_, 4); + Dec(argsNum); + end; + Env.AddToBody(');'); + result:=false; + Exit; + end; Env.ErrAdr := curAdr; raise Exception.Create('Under construction'); end; @@ -3829,7 +3985,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) from := IntToStr(Env.Stack[varIdxInfo.IdxValue].IntValue) else from := Env.Stack[varIdxInfo.IdxValue].Value; - Env.Stack[varIdxInfo.IdxValue].Value := Env.GetLvarName(varIdxInfo.IdxValue); + Env.Stack[varIdxInfo.IdxValue].Value := Env.GetLvarName(varIdxInfo.IdxValue, 'Integer'); break; End; End; @@ -3841,7 +3997,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) from := IntToStr(Env.Stack[varIdxInfo.IdxValue].IntValue) else from := Env.Stack[varIdxInfo.IdxValue].Value; - Env.Stack[varIdxInfo.IdxValue].Value := Env.GetLvarName(varIdxInfo.IdxValue); + Env.Stack[varIdxInfo.IdxValue].Value := Env.GetLvarName(varIdxInfo.IdxValue, 'Integer'); break; End; End; @@ -4263,7 +4419,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) Exclude(item.Flags, IF_INTVAL); End; //else _to := item.Value; - item.Value := Env.GetLvarName(cntIdxInfo.IdxValue); + item.Value := Env.GetLvarName(cntIdxInfo.IdxValue, 'Integer'); Env.Stack[cntIdxInfo.IdxValue] := item; End; End @@ -4286,7 +4442,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) Begin item := Env.Stack[varIdxInfo.IdxValue]; from := item.Value1; - item.Value := Env.GetLvarName(varIdxInfo.IdxValue); + item.Value := Env.GetLvarName(varIdxInfo.IdxValue, 'Integer'); Include(item.Flags, IF_CYCLE_VAR); Env.Stack[varIdxInfo.IdxValue] := item; End; @@ -4305,7 +4461,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) else if cntIdxInfo.IdxType = itLVAR then Begin cnt := Env.Stack[cntIdxInfo.IdxValue].Value; - Env.Stack[cntIdxInfo.IdxValue].Value := Env.GetLvarName(cntIdxInfo.IdxValue); + Env.Stack[cntIdxInfo.IdxValue].Value := Env.GetLvarName(cntIdxInfo.IdxValue, 'Integer'); End; if SameText(from, '1') then _to := cnt else if SameText(from, '0') then _to := cnt + ' - 1' @@ -4319,15 +4475,16 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) Result:= TLoopInfo.Create('R', fromAdr, brkAdr, lastAdr); //repeat end; -Procedure TDecompiler.SimulatePush (curAdr:Integer); +procedure TDecompiler.SimulatePush(curAdr:Integer;bShowComment:Boolean); var _vmt:Boolean; + b:Byte; offset, idx:Integer; - _vmtAdr:Integer; + pdi:PAnsiChar; item, item1:TItem; recN:InfoRec; fInfo:FieldInfo; - _name, typeName, _value:AnsiString; + _name, _type, typeName, _value, regName:AnsiString; Begin //push imm if DisaInfo.OpType[0] = otIMM then @@ -4364,8 +4521,8 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) Exit; End; GetRegItem(idx, item); - _value := GetDecompilerRegisterName(idx); - if item.Value <> '' then _value := item.Value + 'Begin' + _value + 'End;'; + regName:= GetDecompilerRegisterName(idx); + if (item.Value <> '')and not SameText(regName,item.Value) then _value := item.Value + '{' + _value + '}'; item.Value := _value; //push eax - clear flag IF_CALL_RESULT @@ -4380,6 +4537,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) // _item.Name := ''; //End; Push(@item); + if bShowComment then Env.AddToBody('//push ' + regname); Exit; End //push mem @@ -4406,7 +4564,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) //push [ebp-N] if IF_STACK_PTR in item1.Flags then Begin - _name := Env.GetLvarName(item1.IntValue + offset); + _name := Env.GetLvarName(item1.IntValue + offset,''); item := Env.Stack[item1.IntValue + offset]; item.Value := _name; Push(@item); @@ -4449,11 +4607,9 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) Exit; End; //push [reg+N] - fInfo := FMain.GetField(typeName, offset, _vmt, _vmtAdr); - if Assigned(fInfo) then + if GetField(typeName, offset, _name, _type)<>0 then Begin InitItem(@item); - _name := GetFieldName(fInfo); if SameText(item1.Value, 'Self') then item.Value := _name else @@ -4493,7 +4649,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) Procedure TDecompiler.SimulatePop (curAdr:Integer); Var - line:AnsiString; + regName:AnsiString; item:PItem; Begin //pop reg @@ -4503,10 +4659,11 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) if IF_ARG in item.Flags then if not IsFlagSet([cfFrame], Adr2Pos(curAdr)) then begin - line := GetDecompilerRegisterName(DisaInfo.OpRegIdx[0]) + ' := ' + item.Name + ';'; - Env.AddToBody(line); + regName := GetDecompilerRegisterName(DisaInfo.OpRegIdx[0]); + Env.AddToBody('//pop '+regName); end; item.Precedence := PRECEDENCE_NONE; + item.Value:=regName; SetRegItem(DisaInfo.OpRegIdx[0], item^); Exit; End @@ -4654,7 +4811,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) item._Type := 'Integer'; SetRegItem(16, item); SetRegItem(18, item); - line := 'EDX_EAX := EAX * ' + Env.GetLvarName(_ESP_ + offset) + '; //' + item1.Value; + line := 'EDX_EAX := EAX * ' + Env.GetLvarName(_ESP_ + offset, 'Integer') + '; //' + item1.Value; Env.AddToBody(line); Exit; End; @@ -4667,14 +4824,14 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) if item1.Value <> '' then _name := item1.Value else - _name := Env.GetLvarName(itemBase.IntValue + offset); + _name := Env.GetLvarName(itemBase.IntValue + offset, 'Integer'); InitItem(@item); item.Precedence := PRECEDENCE_MULT; item.Value := _name + ' * ' + item2.Value; item._Type := 'Integer'; SetRegItem(16, item); SetRegItem(18, item); - line := 'EDX_EAX := EAX * ' + Env.GetLvarName(_ESP_ + offset) + '; //' + item.Value; + line := 'EDX_EAX := EAX * ' + Env.GetLvarName(_ESP_ + offset, 'Integer') + '; //' + item.Value; Env.AddToBody(line); Exit; End; @@ -4684,7 +4841,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) GetRegItem(16, item2); InitItem(@item); item.Precedence := PRECEDENCE_MULT; - item.Value := GetString(@item2, PRECEDENCE_MULT) + ' * ' + GetString(@itemBase, PRECEDENCE_MULT); + item.Value := GetString(@item2, PRECEDENCE_MULT) + ' * ' + GetString(@itemBase, PRECEDENCE_MULT+1); item._Type := 'Integer'; SetRegItem(16, item); SetRegItem(18, item); @@ -4706,11 +4863,9 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) tmpBuf:PAnsiChar; reg1Idx, pow2, _size:Integer; n,idx, len, ap:Integer; - vmtAdr:Integer; item, item1:TItem; recN:InfoRec; - fInfo:FieldInfo; - _name, _value, typeName, line, comment, imm, txt:AnsiString; + _name, _type, _value, typeName, line, comment, imm, iname,fname, txt:AnsiString; wStr:WideString; Begin reg1Idx := DisaInfo.OpRegIdx[0]; @@ -4889,48 +5044,55 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) End; if item1._Type <> '' then Begin - if item1._Type[1] = '^' then + typeName:=item1._Type; + if item1._Type[1] = '^' then typeName := GetTypeDeref(item1._Type); + + kind := GetTypeKind(typeName, _size); + if kind = ikRecord then Begin - typeName := GetTypeDeref(item1._Type); - kind := GetTypeKind(typeName, _size); - if kind = ikRecord then + _value := item1.Value; + InitItem(@item); + item.Flags:=[IF_RECORD_FOFS]; + item.Value:=_value; + item._Type:=typeName; + item.Offset:=DisaInfo.Immediate; + SetRegItem(reg1Idx,item); + { + txt := GetRecordFields(DisaInfo.Immediate, typeName); + if Pos(':',txt)<>0 then + Begin + _value:=_value + '.' + ExtractName(txt); + typeName := ExtractType(txt); + End + else + Begin + _value:=_value + '.f' + Val2Str(DisaInfo.Immediate); + typeName := txt; + End; + item.Value := _value; + item._Type := typeName; + SetRegItem(reg1Idx, item); + line := GetDecompilerRegisterName(reg1Idx) + ' := ^' + item.Value; + Env.AddToBody(line); + } + Exit; + End; + if kind=ikVMT then + begin + if GetField(item1._Type, DisaInfo.Immediate, _name, _type)<>0 then Begin - _value := item1.Value; InitItem(@item); - txt := GetRecordFields(DisaInfo.Immediate, typeName); - if Pos(':',txt)<>0 then - Begin - _value:=_value + '.' + ExtractName(txt); - typeName := ExtractType(txt); - End + if SameText(item1.Value, 'Self') then + item.Value := _name else - Begin - _value:=_value + '.f' + Val2Str(DisaInfo.Immediate); - typeName := txt; - End; - item.Value := _value; - item._Type := typeName; + item.Value := item1.Value + '.' + _name; + item._Type := _Type; SetRegItem(reg1Idx, item); - line := GetDecompilerRegisterName(reg1Idx) + ' := ^' + item.Value; + line := GetDecompilerRegisterName(reg1Idx) + ' := ' + item.Value; Env.AddToBody(line); Exit; End; - End; - fInfo := FMain.GetField(item1._Type, DisaInfo.Immediate, _vmt, vmtAdr); - if Assigned(fInfo) then - Begin - InitItem(@item); - _name := GetFieldName(fInfo); - if SameText(item1.Value, 'Self') then - item.Value := _name - else - item.Value := item1.Value + '.' + _name; - item._Type := fInfo._Type; - SetRegItem(reg1Idx, item); - line := GetDecompilerRegisterName(reg1Idx) + ' := ' + item.Value; - Env.AddToBody(line); - Exit; - End; + end; End; if item1.Value <> '' then _value := GetString(@item1, PRECEDENCE_ADD) + ' + ' + imm @@ -5019,7 +5181,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) else Begin item.Precedence := PRECEDENCE_ADD; - item.Value := GetString(@item1, PRECEDENCE_MULT) + ' Or ' + imm; + item.Value := GetString(@item1, PRECEDENCE_ADD) + ' Or ' + imm; item._Type := 'Cardinal'; End; SetRegItem(reg1Idx, item); @@ -5221,7 +5383,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) End; line := GetDecompilerRegisterName(reg1Idx) + ' := ' + GetDecompilerRegisterName(reg1Idx) + _op + GetDecompilerRegisterName(reg2Idx); - comment := GetString(@item1, PRECEDENCE_ADD) + _op + GetString(@item2, PRECEDENCE_ADD); + comment := GetString(@item1, PRECEDENCE_ADD) + _op + GetString(@item2, PRECEDENCE_ADD+1); Env.AddToBody(line + '; //' + comment); InitItem(@item); item.Precedence := PRECEDENCE_ADD; @@ -5238,7 +5400,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) else if Op in [OP_MUL, OP_IMUL, OP_AND, OP_SHR, OP_SHL] then Begin line:=line + GetDecompilerRegisterName(reg1Idx) + ' := ' + GetDecompilerRegisterName(reg1Idx) + _op + GetDecompilerRegisterName(reg2Idx); - comment := GetString(@item1, PRECEDENCE_MULT) + _op + GetString(@item2, PRECEDENCE_MULT); + comment := GetString(@item1, PRECEDENCE_MULT) + _op + GetString(@item2, PRECEDENCE_MULT+1); Env.AddToBody(line + '; //' + comment); InitItem(@item); @@ -5251,7 +5413,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) else if (Op = OP_DIV) or (Op = OP_IDIV) then Begin line := 'EAX := ' + GetDecompilerRegisterName(reg1Idx) + ' Div ' + GetDecompilerRegisterName(reg2Idx); - comment := GetString(@item1, PRECEDENCE_MULT) + ' Div ' + GetString(@item2, PRECEDENCE_MULT); + comment := GetString(@item1, PRECEDENCE_MULT) + ' Div ' + GetString(@item2, PRECEDENCE_MULT+1); Env.AddToBody(line + '; //' + comment); InitItem(@item); @@ -5259,7 +5421,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) item.Value := comment; item._Type := 'Integer'; SetRegItem(16, item); - item.Value := GetString(@item1, PRECEDENCE_MULT) + ' Mod ' + GetString(@item2, PRECEDENCE_MULT);; + item.Value := GetString(@item1, PRECEDENCE_MULT) + ' Mod ' + GetString(@item2, PRECEDENCE_MULT+1); SetRegItem(18, item); Exit; End @@ -5275,7 +5437,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) Procedure TDecompiler.SimulateInstr2RegMem (curAdr:Integer; Op:Byte); var - _op,_fname,_name,_type,_value,line:AnsiString; + _op,fname,_name,_type,_value,line:AnsiString; reg1Idx,fOffset,offset,ap,adr,size:Integer; itemSrc,itemDst, item,item1,item2:TItem; recN,recN1:InfoRec; @@ -5307,7 +5469,6 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) //Arg if IF_ARG in item.Flags then Begin - Exclude(item.Flags, IF_ARG); //_item.Flags := _item.Flags and not IF_VAR; item.Value := item.Name; SetRegItem(reg1Idx, item); @@ -5325,15 +5486,16 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) else if IF_FIELD in item.Flags then Begin fOffset := item.Offset; - _fname := GetRecordFields(fOffset, Env.Stack[itemSrc.IntValue - fOffset]._Type); + fname := GetRecordFields(fOffset, Env.Stack[itemSrc.IntValue - fOffset]._Type); _name := Env.Stack[itemSrc.IntValue - fOffset].Value; + _type := ExtractType(fname); if _name = '' then - _name := Env.GetLvarName(itemSrc.IntValue - fOffset); + _name := Env.GetLvarName(itemSrc.IntValue - fOffset,_type); InitItem(@itemDst); - if Pos(':',_fname)<>0 then + if Pos(':',fname)<>0 then Begin - itemDst.Value := _name + '.' + ExtractName(_fname); - itemDst._Type := ExtractType(_fname); + itemDst.Value := _name + '.' + ExtractName(fname); + itemDst._Type := ExtractType(fname); End else itemDst.Value := _name + '.f' + Val2Str(fOffset); SetRegItem(reg1Idx, itemDst); @@ -5343,7 +5505,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) if item.Name <> '' then _value := item.Name else Begin - _value := Env.GetLvarName(itemSrc.IntValue); + _value := Env.GetLvarName(itemSrc.IntValue,''); if item.Value <> '' then _value:=_value + 'Begin' + item.Value + 'End;'; End; @@ -5364,14 +5526,14 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) if IF_FIELD in item.Flags then Begin fOffset := item.Offset; - _fname := GetRecordFields(fOffset, Env.Stack[itemSrc.IntValue - fOffset]._Type); + fname := GetRecordFields(fOffset, Env.Stack[itemSrc.IntValue - fOffset]._Type); _name := Env.Stack[itemSrc.IntValue - fOffset].Value; itemDst.Flags := []; itemDst.Precedence := PRECEDENCE_ADD; - if Pos(':',_fname)<>0 then + if Pos(':',fname)<>0 then Begin - itemDst.Value := itemDst.Value + _op + _name + '.' + ExtractName(_fname); - itemDst._Type := ExtractType(_fname); + itemDst.Value := itemDst.Value + _op + _name + '.' + ExtractName(fname); + itemDst._Type := ExtractType(fname); End else itemDst.Value := itemDst.Value + _op + _name + '.f' + Val2Str(fOffset); SetRegItem(reg1Idx, itemDst); @@ -5430,7 +5592,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) if Assigned(recN) then Begin //VMT - if recN.kind = ikVMT then + if (recN.kind = ikVMT)or(recN.kind = ikDynArray) then Begin InitItem(@item); item.Flags := [IF_INTVAL]; @@ -5457,8 +5619,8 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) item.Value := recN1.Name; item._Type := '^' + recN1._type; SetRegItem(reg1Idx, item); + Exit; End; - Exit; End; End; End @@ -5516,13 +5678,11 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) End; if (Op = OP_MOV) or (Op = OP_LEA) then Begin - InitItem(@item); - item.Flags := itemSrc.Flags; - item.Value := itemSrc.Value; - item._Type := itemSrc._Type; - //if Op = OP_LEA then _item.Type := '^' + _item.Type; - SetRegItem(reg1Idx, item); - line := GetDecompilerRegisterName(reg1Idx) + ' := ' + item.Value + ';'; + SetRegItem(reg1Idx, itemSrc); + line := GetDecompilerRegisterName(reg1Idx) + ' := ' + itemSrc.Value + ';'; + if IF_RECORD_FOFS in itemSrc.Flags then + line:=line + '.' + GetRecordFields(itemSrc.Offset, itemSrc._Type); + line:=line + ';'; Env.AddToBody(line); Exit; End @@ -5539,7 +5699,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) Begin InitItem(@item); item.Precedence := PRECEDENCE_ADD; - item.Value := GetString(@itemDst, PRECEDENCE_ADD) + _op + GetString(@itemSrc, PRECEDENCE_ADD); + item.Value := GetString(@itemDst, PRECEDENCE_ADD) + _op + GetString(@itemSrc, PRECEDENCE_ADD+1); item._Type := itemSrc._Type; SetRegItem(reg1Idx, item); line := GetDecompilerRegisterName(reg1Idx) + ' := ' + GetDecompilerRegisterName(reg1Idx) @@ -5551,7 +5711,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) Begin InitItem(@item); item.Precedence := PRECEDENCE_MULT; - item.Value := GetString(@itemDst, PRECEDENCE_MULT) + _op + GetString(@itemSrc, PRECEDENCE_MULT); + item.Value := GetString(@itemDst, PRECEDENCE_MULT) + _op + GetString(@itemSrc, PRECEDENCE_MULT+1); item._Type := itemSrc._Type; SetRegItem(reg1Idx, item); line := GetDecompilerRegisterName(reg1Idx) + ' := ' + GetDecompilerRegisterName(reg1Idx) @@ -5563,13 +5723,13 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) Begin InitItem(@item); item.Precedence := PRECEDENCE_MULT; - item.Value := GetString(@itemDst, PRECEDENCE_MULT) + ' Div ' + GetString(@itemSrc, PRECEDENCE_MULT); + item.Value := GetString(@itemDst, PRECEDENCE_MULT) + ' Div ' + GetString(@itemSrc, PRECEDENCE_MULT+1); item._Type := itemSrc._Type; SetRegItem(16, item); InitItem(@item); item.Precedence := PRECEDENCE_MULT; - item.Value := GetString(@itemDst, PRECEDENCE_MULT) + ' Mod ' + GetString(@itemSrc, PRECEDENCE_MULT); + item.Value := GetString(@itemDst, PRECEDENCE_MULT) + ' Mod ' + GetString(@itemSrc, PRECEDENCE_MULT+1); itemDst._Type := itemSrc._Type; SetRegItem(18, item); @@ -5888,6 +6048,9 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) CompInfo.R := _name; Exit; End; + line:=_name + ' AND ' + GetImmString(typeName, DisaInfo.Immediate) + ';'; + Env.AddToBody(line); + Exit; End; Env.ErrAdr := curAdr; raise Exception.Create('Under construction'); @@ -5922,13 +6085,15 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) if IF_CALL_RESULT in itemSrc.Flags then Begin Exclude(itemSrc.Flags, IF_CALL_RESULT); - itemSrc.Value := Env.GetLvarName(itemDst.IntValue); + itemSrc.Value := Env.GetLvarName(itemDst.IntValue,''); SetRegItem(reg2Idx, itemSrc); End else Begin if not(IF_ARG in itemSrc.Flags) then - itemSrc.Name := Env.GetLvarName(itemDst.IntValue); + itemSrc.Name := Env.GetLvarName(itemDst.IntValue,''); + If itemSrc.Value<>'' Then + itemSrc.Value:=Env.GetLvarName(itemDst.IntValue,''); End; Env.Stack[itemDst.IntValue] := itemSrc; line := _name + ' := ' + _value + ';'; @@ -5974,6 +6139,29 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) if IF_INTVAL in itemDst.Flags then Begin _offset := itemDst.IntValue; + ap := Adr2Pos(_offset); + recN := GetInfoRec(_offset); + if Assigned(recN) then MakeGvar(recN, _offset, curAdr); + if ap >= 0 then + begin + adr := PInteger(Code + ap)^; + //May be pointer to var + if IsValidImageAdr(adr) then + Begin + recN := GetInfoRec(adr); + if Assigned(recN) then + Begin + MakeGvar(recN, _offset, curAdr); + line := '^'; + end; + end; + end; + if Assigned(recN) then + begin + if (itemSrc._Type <> '') then recN._type := itemSrc._Type; + _name := recN.Name; + end; + { if Op = OP_MOV then Begin ap := Adr2Pos(_offset); @@ -6006,6 +6194,7 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) Env.ErrAdr := curAdr; raise Exception.Create('Under construction'); End; + } End; if Op = OP_MOV then Begin @@ -6044,6 +6233,12 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) Env.AddToBody(line); Exit; End + Else if Op = OP_XOR Then + Begin + line := _name + ' := ' + _name + ' Xor ' + _value + ';'; + Env.AddToBody(line); + Exit; + end else if Op = OP_TEST then Begin CompInfo.L := _name + ' And ' + _value; @@ -6055,11 +6250,9 @@ constructor TDecompileEnv.Create(AStartAdr:Integer; ASize:Integer; recN:InfoRec) End else if Op = OP_BT then Begin - CompInfo.L := _name + '[' + _value + ']'; - CompInfo.O := CmpOp; - CompInfo.R := 'True'; - line := _name + ' := ' + _name + '[' + _value + '];'; - Env.AddToBody(line); + CompInfo.L := _value; + CompInfo.O := 'Q'; + CompInfo.R := _name; Exit; End; Env.ErrAdr := curAdr; @@ -6555,10 +6748,12 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL else if SameText(AName, '@BlockWrite') then Result:= 'Write' else if SameText(AName, '@ChDir') then Result:= 'ChDir' else if SameText(AName, '@Close') then Result:= 'CloseFile' + else if SameText(AName, '@DynArrayHigh') then Result:= 'High' else if SameText(AName, '@EofText') then Result:= 'Eof' else if SameText(AName, '@FillChar')then Result:= 'FillChar' else if SameText(AName, '@Flush')then Result:= 'Flush' - else if SameText(AName, '@LStrCopy') or + else if SameText(AName, '@Copy') or + SameText(AName, '@LStrCopy') or SameText(AName, '@WStrCopy') or SameText(AName, '@UStrCopy') then Result:= 'Copy' else if SameText(AName, '@LStrDelete') or @@ -6570,7 +6765,10 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL SameText(AName, '@WStrLen') or SameText(AName, '@UStrLen') then Result:= 'Length' else if SameText(AName, '@LStrOfChar') then Result:= 'StringOfChar' - else if SameText(AName, '@LStrPos') then Result:= 'Pos' + else if SameText(AName,'@Pos') or + SameText(AName, '@LStrPos') or + SameText(AName, '@WStrPos') or + SameText(AName, '@UStrPos') then Result:= 'Pos' else if SameText(AName, '@LStrSetLength') or SameText(AName, '@UStrSetLength') then Result:= 'SetLength' else if SameText(AName, '@MkDir') then Result:= 'MkDir' @@ -6628,17 +6826,18 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL Begin //dest:Pointer GetRegItem(16, item1); - if IF_STACK_PTR in item1.Flags then - Begin - Env.Stack[item1.IntValue].Value := Env.GetLvarName(item1.IntValue); - item1 := Env.Stack[item1.IntValue]; - End; //source:Pointer GetRegItem(18, item2); //typeInfo:Pointer GetRegItem(17, item3); recN := GetInfoRec(item3.IntValue); - Env.Stack[item1.IntValue]._Type := recN.Name; + _typeName:=recN.Name; + if IF_STACK_PTR in item1.Flags then + Begin + Env.Stack[item1.IntValue].Value := Env.GetLvarName(item1.IntValue,_typeName); + item1 := Env.Stack[item1.IntValue]; + End; + Env.Stack[item1.IntValue]._Type := _typeName; line := item1.Value + ' := ' + item2.Value + ';'; Env.AddToBody(line); Exit; @@ -6650,15 +6849,15 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL if IF_STACK_PTR in item1.Flags then Begin if Env.Stack[item1.IntValue].Value = '' then - Env.Stack[item1.IntValue].Value := Env.GetLvarName(item1.IntValue); + Env.Stack[item1.IntValue].Value := Env.GetLvarName(item1.IntValue,'array of'); item1 := Env.Stack[item1.IntValue]; End; //edx - src GetRegItem(18, item2); if IF_STACK_PTR in item2.Flags then Begin - if Env.Stack[item2.IntValue].Value = '' then - Env.Stack[item2.IntValue].Value := Env.GetLvarName(item2.IntValue); + if Env.Stack[item2.IntValue].Value = '' then + Env.Stack[item2.IntValue].Value := Env.GetLvarName(item2.IntValue,'array of'); item2 := Env.Stack[item2.IntValue]; End; line := item1.Value + ' := ' + item2.Value + ';'; @@ -6672,7 +6871,7 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL if IF_STACK_PTR in item1.Flags then Begin if Env.Stack[item1.IntValue].Value = '' then - Env.Stack[item1.IntValue].Value := Env.GetLvarName(item1.IntValue); + Env.Stack[item1.IntValue].Value := Env.GetLvarName(item1.IntValue,'array of'); item1 := Env.Stack[item1.IntValue]; End; line := item1.Value + ' := Nil;'; @@ -6685,8 +6884,8 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL GetRegItem(16, item1); if IF_STACK_PTR in item1.Flags then Begin - if Env.Stack[item1.IntValue].Value = '' then - Env.Stack[item1.IntValue].Value := Env.GetLvarName(item1.IntValue); + if Env.Stack[item1.IntValue].Value = '' then + Env.Stack[item1.IntValue].Value := Env.GetLvarName(item1.IntValue,'array of'); item1 := Env.Stack[item1.IntValue]; End; _value := 'Length(' + item1.Value + ')'; @@ -6704,16 +6903,19 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL //eax - dst GetRegItem(16, item1); item := item1; + //edx - type of DynArray + GetRegItem(18, item2); + _typeName:=GetTypeName(item2.IntValue); if IF_STACK_PTR in item1.Flags then Begin - if Env.Stack[item1.IntValue].Value = '' then - Env.Stack[item1.IntValue].Value := Env.GetLvarName(item1.IntValue); + if Env.Stack[item1.IntValue].Value = '' then + Env.Stack[item1.IntValue].Value := Env.GetLvarName(item1.IntValue,_typeName); item := Env.Stack[item1.IntValue]; - End; - line := 'SetLength(' + item.Value; - //edx - type of DynArray - GetRegItem(18, item2); - Env.Stack[item1.IntValue]._Type := GetTypeName(item2.IntValue); + Env.Stack[item1.IntValue]._Type := _typeName; + line := 'SetLength(' + item.Value; + End + else if IF_INTVAL in item1.Flags then + line := 'SetLength(' + MakeGvarName(item1.IntValue); //ecx - dims cnt GetRegItem(17, item3); cnt := item3.IntValue; @@ -6802,7 +7004,7 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL Env.Stack[item1.IntValue + r] := item; End; if Env.Stack[item1.IntValue].Value = '' then - Env.Stack[item1.IntValue].Value := Env.GetLvarName(item1.IntValue); + Env.Stack[item1.IntValue].Value := Env.GetLvarName(item1.IntValue,_typeName); Env.Stack[item1.IntValue]._Type := _typeName; End; Exit; @@ -6813,18 +7015,26 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL //eax - dst GetRegItem(16, item1); item := item1; + //edx - type of DynArray + GetRegItem(18, item2); + //ecx - dims cnt + GetRegItem(17, item3); + _typeName:='array [1..'+IntToStr(cnt)+'] of '+GetTypeName(item2.IntValue); if IF_STACK_PTR in item1.Flags then Begin if Env.Stack[item1.IntValue].Value = '' then - Env.Stack[item1.IntValue].Value := Env.GetLvarName(item1.IntValue); + Env.Stack[item1.IntValue].Value := Env.GetLvarName(item1.IntValue,_typeName); item := Env.Stack[item1.IntValue]; End; - //edx - type of DynArray + Env.Stack[item1.IntValue]._Type := _typeName; + Exit; + End + else if SameText(name, '@IntfCast') then + Begin + GetRegItem(16, item1); GetRegItem(18, item2); - //ecx - dims cnt - GetRegItem(17, item3); - cnt := item3.IntValue; - Env.Stack[item1.IntValue]._Type := 'array [1..' + IntToStr(cnt) + '] of ' + GetTypeName(item2.IntValue);; + line := '('+item1.Value + ' as ' + item2.Value1+')'; + Env.AddToBody(line); Exit; End else if SameText(name, '@IntfClear') then @@ -6898,7 +7108,7 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL if IF_STACK_PTR in item.Flags then Begin Env.Stack[item.IntValue].Flags := []; - Env.Stack[item.IntValue].Value := Env.GetLvarName(item.IntValue); + Env.Stack[item.IntValue].Value := Env.GetLvarName(item.IntValue,'String'); if name[2] = 'L' then Env.Stack[item.IntValue]._Type := 'AnsiString' else if name[2] = 'W' then @@ -7010,13 +7220,18 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL Begin //eax - dst GetRegItem(16, item1); - if IF_STACK_PTR in item1.Flags then + if IF_INTVAL in item1.Flags then + line:= MakeGvarName(item1.IntValue) + else if IF_STACK_PTR in item1.Flags then + begin + line:=item1.Value; Env.Stack[item1.IntValue]._Type := 'ShortString'; + End; //edx - src GetRegItem(18, item2); if IF_STACK_PTR in item2.Flags then Env.Stack[item2.IntValue]._Type := 'String'; - line := item1.Value + ' := ' + item2.Value + ';'; + line := line + ' := ' + item2.Value + ';'; Env.AddToBody(line); Exit; End @@ -7059,6 +7274,7 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL End else if SameText(name, '@Sin') or SameText(name, '@Cos') or + SameText(name, '@Exp') or SameText(name, '@Int') then Begin _value := Copy(name,2, 5); @@ -7102,7 +7318,8 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL Env.AddToBody(line); Exit; End - else if SameText(name, '@UStrFromWChar') then + else if SameText(name, '@UStrFromChar') or + SameText(name, '@UStrFromWChar') then Begin //eax-Dst GetRegItem(16, item1); @@ -7111,7 +7328,10 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL //edx-Src GetRegItem(18, item2); if IF_STACK_PTR in item2.Flags then - Env.Stack[item2.IntValue]._Type := 'WideChar'; + begin + if name[11]='C' then Env.Stack[item2.IntValue]._Type := 'Char' + else Env.Stack[item2.IntValue]._Type := 'WideChar'; + end; line := item1.Value + ' := ' + item2.Value; Env.AddToBody(line); Exit; @@ -7337,7 +7557,7 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL begin GetRegItem(16, item1); if IF_STACK_PTR in item1.Flags then - line := Env.GetLvarName(item1.IntValue); + line := Env.GetLvarName(item1.IntValue,'Variant'); line:=line + ' := Variant(' + FPop.Value + ')'; Env.AddToBody(line); Exit; @@ -7349,7 +7569,7 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL if IF_STACK_PTR in item1.Flags then Env.Stack[item1.IntValue]._Type := 'Variant'; InitItem(@item); - item.Value := 'Integer(' + Env.GetLvarName(item1.IntValue) + ')'; + item.Value := 'Integer(' + Env.GetLvarName(item1.IntValue,'Variant') + ')'; SetRegItem(16, item); line := 'EAX := ' + item.Value + ';'; Env.AddToBody(line); @@ -7365,7 +7585,7 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL InitItem(@item); item.Value := 'Integer(' + item1.Value + ')'; SetRegItem(16, item); - line := Env.GetLvarName(item2.IntValue) + ' := ' + item.Value + ';'; + line := Env.GetLvarName(item2.IntValue,'Variant') + ' := ' + item.Value + ';'; Env.AddToBody(line); Exit; End @@ -7374,15 +7594,35 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL //edx=Variant, eax=String GetRegItem(18, item1); GetRegItem(16, item2); - if IF_STACK_PTR in item1.Flags then + if IF_INTVAL in item2.Flags then // !!!Use it for other cases!!! + line := MakeGvarName(item2.IntValue) + else if IF_STACK_PTR in item2.Flags then + begin + line := Env.GetLvarName(item2.IntValue, 'String'); + Env.Stack[item2.IntValue]._Type := 'String'; + end + else line := item2.Value; + if IF_STACK_PTR in item1.Flags then Env.Stack[item1.IntValue]._Type := 'Variant'; InitItem(@item); item.Value := 'String(' + item1.Value + ')'; SetRegItem(16, item); - line := Env.GetLvarName(item2.IntValue) + ' := ' + item.Value + ';'; + line := line + ' := ' + item.Value + ';'; Env.AddToBody(line); Exit; end + else if SameText(name, '@VarToReal') then + begin + //eax=Variant + GetRegItem(16, item1); + if IF_STACK_PTR in item1.Flags then + Env.Stack[item1.IntValue]._Type := 'Variant'; + InitItem(@item); + item.Value := 'Real(' + item1.Value + ')'; + item._Type := 'Extended'; + FSet(0, @item); + Exit; + end else if SameText(name, '@Write0Ext') then Begin //File @@ -7395,10 +7635,34 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL Env.AddToBody(line); Exit; End + else if SameText(name, '@Str0Ext') then + begin + //Value (Extended) + GetFloatItemFromStack(_ESP_, @item1, FT_EXTENDED); + Inc(_ESP_, 12); + //Destination - eax + GetRegItem(16, item2); + line := 'Str(' + item1.Value + ', ' + item2.Value + ');'; + Env.AddToBody(line); + Exit; + end + else if SameText(name, '@Str1Ext') then + begin + //Value (Extended) + GetFloatItemFromStack(_ESP_, @item1, FT_EXTENDED); + Inc(_ESP_, 12); + //Width - eax + GetRegItem(16, item2); + //Destination - edx + GetRegItem(18, item3); + line := 'Str(' + item1.Value + ':' + IntToStr(item2.IntValue) + ', ' + item3.Value + ');'; + Env.AddToBody(line); + Exit; + end else if SameText(name, '@Str2Ext') then Begin //Value (Extended) - GetFloatItemFromStack(_ESP_, @item1, FT_EXTENDED); + GetFloatItemFromStack(_ESP_, @item1, FT_EXTENDED); Inc(_ESP_, 12); //Width - eax GetRegItem(16, item2); @@ -7406,7 +7670,7 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL GetRegItem(18, item3); //Destination - ecx GetRegItem(17, item4); - line:=line + 'Str(' + item1.Value + ':' + IntToStr(item2.IntValue) + line:= 'Str(' + item1.Value + ':' + IntToStr(item2.IntValue) + ':' + IntToStr(item3.IntValue) + ', ' + item4.Value + ');'; Env.AddToBody(line); Exit; @@ -7423,7 +7687,7 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL GetRegItem(18, item3); //ecx GetRegItem(17, item4); - line:=line + 'Write(' + ExtractClassName(item1.Value) + ', ' + item2.Value + line:= 'Write(' + ExtractClassName(item1.Value) + ', ' + item2.Value + ':' + IntToStr(item3.IntValue) + ':' + IntToStr(item4.IntValue) + ');'; Env.AddToBody(line); Exit; @@ -7468,7 +7732,7 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL if IF_STACK_PTR in item1.Flags then Begin item := Env.Stack[item1.IntValue]; - item.Value := Env.GetLvarName(item1.IntValue); + item.Value := Env.GetLvarName(item1.IntValue,'String'); item._Type := 'WideString'; Env.Stack[item1.IntValue] := item; item1 := item; @@ -7627,7 +7891,9 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL SameText(name, '@_IOTest') or SameText(name, '@CheckAutoResult') or SameText(name, '@InitExe') or - SameText(name, '@InitLib') then Exit; + SameText(name, '@InitLib') or + SameText(name, '@IntfAddRef') or + SameText(name, '@TryFinallyExit') then Exit; Env.ErrAdr := procAdr; raise Exception.Create('Under construction'); end; @@ -7664,13 +7930,13 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL Env.LastResString := ''; end; -Procedure TDecompiler.SimulateFloatInstruction (curAdr:Integer; instrLen:Integer); +Procedure TDecompiler.SimulateFloatInstruction (curAdr:Integer); var reverse, pop1, pop2:Boolean; _pos,reg1Idx, reg2Idx, sz, _ofs:Integer; _item, itemSrc:TItem; recN:InfoRec; - _val, line:AnsiString; + _name,_val, line, varName:AnsiString; Begin reverse := false; pop1 := false; @@ -7726,24 +7992,45 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL //op Mem if DisaInfo.OpType[0] = otMEM then Begin + //fst(p) [esp] + if (DisaInfo.BaseReg = 20) and (DisaInfo.Offset=0) then + begin + _item := Env.FStack[_TOP_]; + if pop1 then FPop; + _ofs := _ESP_; + sz := DisaInfo.OpSize; + Env.Stack[_ofs] := _item; + Inc(_ofs, 4); + Dec(sz, 4); + InitItem(@_item); + while sz > 0 do + begin + Env.Stack[_ofs] := _item; + Inc(_ofs, 4); + Dec(sz, 4); + end; + Exit; + end; GetMemItem(curAdr, @itemSrc, 0); if IF_STACK_PTR in itemSrc.Flags then Begin _item := Env.FStack[_TOP_]; if pop1 then FPop; - line := Env.GetLvarName(itemSrc.IntValue) + ' := ' + _item.Value + ';'; + varName:=Env.GetLvarName(itemSrc.IntValue,'Double'); + line := varName + ' := ' + _item.Value + ';'; Env.AddToBody(line); - _item.Value := Env.GetLvarName(itemSrc.IntValue); - _ofs := itemSrc.IntValue; - sz := DisaInfo.MemSize; - Env.Stack[_ofs] := _item; + _item.Precedence := PRECEDENCE_NONE; + _item.Value:=varName; + _ofs := itemSrc.IntValue; + sz := DisaInfo.OpSize; + Env.Stack[_ofs] := _item; Inc(_ofs, 4); Dec(sz, 4); InitItem(@_item); while sz > 0 do Begin - Env.Stack[_ofs] := _item; - Inc(_ofs, 4); + Env.Stack[_ofs] := _item; + Inc(_ofs, 4); Dec(sz, 4); End; Exit; @@ -7805,7 +8092,7 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL if _item.Value <> '' then CompInfo.R := _item.Value else - CompInfo.R := Env.GetLvarName(itemSrc.IntValue); + CompInfo.R := Env.GetLvarName(itemSrc.IntValue,'Double'); if pop1 then Begin FPop; @@ -7853,8 +8140,8 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL if DisaInfo.OpNum = 0 then Begin InitItem(@_item); + _item.Value := GetString(FGet(0), PRECEDENCE_ADD) + ' + ' + GetString(FGet(1), PRECEDENCE_ADD+1); _item.Precedence := PRECEDENCE_ADD; - _item.Value := GetString(FGet(0), PRECEDENCE_ADD) + ' + ' + GetString(FGet(1), PRECEDENCE_ADD); _item._Type := 'Extended'; FSet(1, @_item); FPop; @@ -7869,34 +8156,35 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL if IF_STACK_PTR in itemSrc.Flags then Begin _item := Env.Stack[itemSrc.IntValue]; + _name:=_item.Name; if _item.Value <> '' then - _val := GetString(@_item, PRECEDENCE_ADD) + _val := GetString(@_item, PRECEDENCE_ADD+1) else - _val := Env.GetLvarName(itemSrc.IntValue); + _val := Env.GetLvarName(itemSrc.IntValue,'Extended'); InitItem(@_item); + _item.Value := GetString(FGet(0), PRECEDENCE_ADD) + ' + ' + _name + '{' + _val + '}'; _item.Precedence := PRECEDENCE_ADD; - _item.Value := GetString(FGet(0), PRECEDENCE_ADD) + ' + ' + _val; _item._Type := 'Extended'; FSet(0, @_item); Exit; - End; - if IF_INTVAL in itemSrc.Flags then + End + Else if IF_INTVAL in itemSrc.Flags then Begin recN := GetInfoRec(itemSrc.IntValue); if Assigned(recN) and recN.HasName then - _val := recN.Name + _name := recN.Name else - _val := GetGvarName(itemSrc.IntValue); + _name := GetGvarName(itemSrc.IntValue); InitItem(@_item); + _item.Value := GetString(FGet(0), PRECEDENCE_ADD) + ' + ' + _name; _item.Precedence := PRECEDENCE_ADD; - _item.Value := GetString(FGet(0), PRECEDENCE_ADD) + ' + ' + recN.Name; _item._Type := 'Extended'; FSet(0, @_item); Exit; End; InitItem(@_item); - _item.Precedence := PRECEDENCE_ADD; _item.Value := GetString(FGet(0), PRECEDENCE_ADD) + ' + ' + itemSrc.Value; + _item.Precedence := PRECEDENCE_ADD; _item._Type := 'Extended'; FSet(0, @_item); Exit; @@ -7908,8 +8196,8 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL reg1Idx := DisaInfo.OpRegIdx[0] - 30; reg2Idx := DisaInfo.OpRegIdx[1] - 30; InitItem(@_item); + _item.Value := GetString(FGet(reg1Idx), PRECEDENCE_ADD) + ' + ' + GetString(FGet(reg2Idx), PRECEDENCE_ADD+1); _item.Precedence := PRECEDENCE_ADD; - _item.Value := GetString(FGet(reg1Idx), PRECEDENCE_ADD) + ' + ' + GetString(FGet(reg2Idx), PRECEDENCE_ADD); _item._Type := 'Extended'; FSet(reg1Idx, @_item); //faddp @@ -7931,11 +8219,11 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL if DisaInfo.OpNum = 0 then Begin InitItem(@_item); - _item.Precedence := PRECEDENCE_ADD; if reverse then - _item.Value := GetString(FGet(0), PRECEDENCE_ADD) + ' - ' + GetString(FGet(1), PRECEDENCE_ADD) + _item.Value := GetString(FGet(0), PRECEDENCE_ADD) + ' - ' + GetString(FGet(1), PRECEDENCE_ADD+1) else - _item.Value := GetString(FGet(1), PRECEDENCE_ADD) + ' - ' + GetString(FGet(0), PRECEDENCE_ADD); + _item.Value := GetString(FGet(1), PRECEDENCE_ADD) + ' - ' + GetString(FGet(0), PRECEDENCE_ADD+1); + _item.Precedence := PRECEDENCE_ADD; _item._Type := 'Extended'; FSet(1, @_item); FPop; @@ -7950,16 +8238,17 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL if IF_STACK_PTR in itemSrc.Flags then Begin _item := Env.Stack[itemSrc.IntValue]; + _name:=_item.Name; if _item.Value <> '' then _val := GetString(@_item, PRECEDENCE_ADD) else - _val := Env.GetLvarName(itemSrc.IntValue); + _val := Env.GetLvarName(itemSrc.IntValue,'Extended'); InitItem(@_item); - _item.Precedence := PRECEDENCE_ADD; if reverse then - _item.Value := _val + ' - ' + GetString(FGet(0), PRECEDENCE_ADD) + _item.Value := _name + '{' + _val + '} - ' + GetString(FGet(0), PRECEDENCE_ADD+1) else - _item.Value := GetString(FGet(0), PRECEDENCE_ADD) + ' - ' + _val; + _item.Value := GetString(FGet(0), PRECEDENCE_ADD) + ' - ' + _name + '{' + _val + '}'; + _item.Precedence := PRECEDENCE_ADD; _item._Type := 'Extended'; FSet(0, @_item); Exit; @@ -7968,25 +8257,25 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL Begin recN := GetInfoRec(itemSrc.IntValue); if Assigned(recN) and recN.HasName then - _val := recN.Name + _name := recN.Name else - _val := GetGvarName(itemSrc.IntValue); + _name := GetGvarName(itemSrc.IntValue); InitItem(@_item); - _item.Precedence := PRECEDENCE_ADD; if reverse then - _item.Value := _val + ' - ' + GetString(FGet(0), PRECEDENCE_ADD) + _item.Value := _name + ' - ' + GetString(FGet(0), PRECEDENCE_ADD+1) else - _item.Value := GetString(FGet(0), PRECEDENCE_ADD) + ' - ' + _val; + _item.Value := GetString(FGet(0), PRECEDENCE_ADD) + ' - ' + _name; + _item.Precedence := PRECEDENCE_ADD; _item._Type := 'Extended'; FSet(0, @_item); Exit; End; InitItem(@_item); - _item.Precedence := PRECEDENCE_ADD; if reverse then - _item.Value := itemSrc.Value + ' - ' + GetString(FGet(0), PRECEDENCE_ADD) + _item.Value := itemSrc.Value + ' - ' + GetString(FGet(0), PRECEDENCE_ADD+1) else _item.Value := GetString(FGet(0), PRECEDENCE_ADD) + ' - ' + itemSrc.Value; + _item.Precedence := PRECEDENCE_ADD; _item._Type := 'Extended'; FSet(0, @_item); Exit; @@ -7998,11 +8287,11 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL reg1Idx := DisaInfo.OpRegIdx[0] - 30; reg2Idx := DisaInfo.OpRegIdx[1] - 30; InitItem(@_item); - _item.Precedence := PRECEDENCE_ADD; if reverse then - _item.Value := GetString(FGet(reg2Idx), PRECEDENCE_ADD) + ' - ' + GetString(FGet(reg1Idx), PRECEDENCE_ADD) + _item.Value := GetString(FGet(reg2Idx), PRECEDENCE_ADD) + ' - ' + GetString(FGet(reg1Idx), PRECEDENCE_ADD+1) else - _item.Value := GetString(FGet(reg1Idx), PRECEDENCE_ADD) + ' - ' + GetString(FGet(reg2Idx), PRECEDENCE_ADD); + _item.Value := GetString(FGet(reg1Idx), PRECEDENCE_ADD) + ' - ' + GetString(FGet(reg2Idx), PRECEDENCE_ADD+1); + _item.Precedence := PRECEDENCE_ADD; _item._Type := 'Extended'; FSet(reg1Idx, @_item); //fsubp @@ -8019,8 +8308,8 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL if DisaInfo.OpNum = 0 then Begin InitItem(@_item); + _item.Value := GetString(FGet(0), PRECEDENCE_MULT) + ' * ' + GetString(FGet(1), PRECEDENCE_MULT+1); _item.Precedence := PRECEDENCE_MULT; - _item.Value := GetString(FGet(0), PRECEDENCE_MULT) + ' * ' + GetString(FGet(1), PRECEDENCE_MULT); _item._Type := 'Extended'; FSet(1, @_item); FPop; @@ -8035,13 +8324,14 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL if IF_STACK_PTR in itemSrc.Flags then Begin _item := Env.Stack[itemSrc.IntValue]; + _name:=_item.Name; if _item.Value <> '' then _val := GetString(@_item, PRECEDENCE_MULT) else - _val := Env.GetLvarName(itemSrc.IntValue); + _val := Env.GetLvarName(itemSrc.IntValue,'Extended'); InitItem(@_item); + _item.Value := GetString(FGet(0), PRECEDENCE_MULT+1) + ' * ' + _name + '{' + _val + '}'; _item.Precedence := PRECEDENCE_MULT; - _item.Value := GetString(FGet(0), PRECEDENCE_MULT) + ' * ' + _val; _item._Type := 'Extended'; FSet(0, @_item); Exit; @@ -8050,19 +8340,19 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL Begin recN := GetInfoRec(itemSrc.IntValue); if Assigned(recN) and recN.HasName then - _val := recN.Name + _name := recN.Name else - _val := GetGvarName(itemSrc.IntValue); + _name := GetGvarName(itemSrc.IntValue); InitItem(@_item); + _item.Value := GetString(FGet(0), PRECEDENCE_MULT) + ' * ' + _name; _item.Precedence := PRECEDENCE_MULT; - _item.Value := GetString(FGet(0), PRECEDENCE_MULT) + ' * ' + _val; _item._Type := 'Extended'; FSet(0, @_item); Exit; End; InitItem(@_item); - _item.Precedence := PRECEDENCE_ADD; _item.Value := GetString(FGet(0), PRECEDENCE_MULT) + ' * ' + itemSrc.Value; + _item.Precedence := PRECEDENCE_ADD; _item._Type := 'Extended'; FSet(0, @_item); Exit; @@ -8074,8 +8364,8 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL reg1Idx := DisaInfo.OpRegIdx[0] - 30; reg2Idx := DisaInfo.OpRegIdx[1] - 30; InitItem(@_item); + _item.Value := GetString(FGet(reg1Idx), PRECEDENCE_MULT) + ' * ' + GetString(FGet(reg2Idx), PRECEDENCE_MULT+1); _item.Precedence := PRECEDENCE_MULT; - _item.Value := GetString(FGet(reg1Idx), PRECEDENCE_MULT) + ' * ' + GetString(FGet(reg2Idx), PRECEDENCE_MULT); _item._Type := 'Extended'; FSet(reg1Idx, @_item); //fmulp @@ -8099,11 +8389,11 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL if DisaInfo.OpNum = 0 then Begin InitItem(@_item); - _item.Precedence := PRECEDENCE_MULT; if reverse then - _item.Value := GetString(FGet(0), PRECEDENCE_MULT) + ' / ' + GetString(FGet(1), PRECEDENCE_MULT) + _item.Value := GetString(FGet(0), PRECEDENCE_MULT) + ' / ' + GetString(FGet(1), PRECEDENCE_MULT+1) else - _item.Value := GetString(FGet(1), PRECEDENCE_MULT) + ' / ' + GetString(FGet(0), PRECEDENCE_MULT); + _item.Value := GetString(FGet(1), PRECEDENCE_MULT) + ' / ' + GetString(FGet(0), PRECEDENCE_MULT+1); + _item.Precedence := PRECEDENCE_MULT; _item._Type := 'Extended'; FSet(1, @_item); FPop; @@ -8119,16 +8409,17 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL if IF_STACK_PTR in itemSrc.Flags then Begin _item := Env.Stack[itemSrc.IntValue]; + _name:=_item.Name; if _item.Value <> '' then _val := GetString(@_item, PRECEDENCE_MULT) else - _val := Env.GetLvarName(itemSrc.IntValue); + _val := Env.GetLvarName(itemSrc.IntValue,'Extended'); InitItem(@_item); - _item.Precedence := PRECEDENCE_MULT; if reverse then - _item.Value := _val + ' / ' + GetString(FGet(0), PRECEDENCE_ADD) + _item.Value := _name + '{' + _val + '} / ' + GetString(FGet(0), PRECEDENCE_MULT+1) else - _item.Value := GetString(FGet(0), PRECEDENCE_ADD) + ' / ' + _val; + _item.Value := GetString(FGet(0), PRECEDENCE_MULT) + ' / ' + _name + '{' + _val + '}'; + _item.Precedence := PRECEDENCE_MULT; _item._Type := 'Extended'; FSet(0, @_item); Exit; @@ -8137,25 +8428,25 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL Begin recN := GetInfoRec(itemSrc.IntValue); if Assigned(recN) and recN.HasName then - _val := recN.Name + _name := recN.Name else - _val := GetGvarName(itemSrc.IntValue); + _name := GetGvarName(itemSrc.IntValue); InitItem(@_item); - _item.Precedence := PRECEDENCE_MULT; if reverse then - _item.Value := _val + ' / ' + GetString(FGet(0), PRECEDENCE_ADD) + _item.Value := _name + ' / ' + GetString(FGet(0), PRECEDENCE_MULT+1) else - _item.Value := GetString(FGet(0), PRECEDENCE_ADD) + ' / ' + _val; + _item.Value := GetString(FGet(0), PRECEDENCE_MULT) + ' / ' + _name; + _item.Precedence := PRECEDENCE_MULT; _item._Type := 'Extended'; FSet(0, @_item); Exit; End; InitItem(@_item); - _item.Precedence := PRECEDENCE_MULT; if reverse then - _item.Value := itemSrc.Value + ' / ' + GetString(FGet(0), PRECEDENCE_MULT) + _item.Value := itemSrc.Value + ' / ' + GetString(FGet(0), PRECEDENCE_MULT+1) else _item.Value := GetString(FGet(0), PRECEDENCE_MULT) + ' / ' + itemSrc.Value; + _item.Precedence := PRECEDENCE_MULT; _item._Type := 'Extended'; FSet(0, @_item); Exit; @@ -8168,11 +8459,11 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL reg1Idx := DisaInfo.OpRegIdx[0] - 30; reg2Idx := DisaInfo.OpRegIdx[1] - 30; InitItem(@_item); - _item.Precedence := PRECEDENCE_MULT; - if reverse then - _item.Value := GetString(FGet(reg2Idx), PRECEDENCE_MULT) + ' / ' + GetString(FGet(reg1Idx), PRECEDENCE_MULT) + if reverse then + _item.Value := GetString(FGet(reg2Idx), PRECEDENCE_MULT) + ' / ' + GetString(FGet(reg1Idx), PRECEDENCE_MULT+1) else - _item.Value := GetString(FGet(reg1Idx), PRECEDENCE_MULT) + ' / ' + GetString(FGet(reg2Idx), PRECEDENCE_MULT); + _item.Value := GetString(FGet(reg1Idx), PRECEDENCE_MULT) + ' / ' + GetString(FGet(reg2Idx), PRECEDENCE_MULT+1); + _item.Precedence := PRECEDENCE_MULT; _item._Type := 'Extended'; FSet(reg1Idx, @_item); //fdivp @@ -8194,7 +8485,8 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL else if DisaInfo.Mnem = 'fchs' then Begin _item := Env.FStack[_TOP_]; - _item.Value := '-' + _item.Value; + _item.Value := '-' + GetString(@_item,PRECEDENCE_ATOM); + _item.Precedence:=PRECEDENCE_UNARY; FSet(0, @_item); Exit; End @@ -8208,6 +8500,16 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL FPush(@_item); Exit; End + //fldln2 + else if DisaInfo.Mnem = 'fldln2' then + begin + InitItem(@_item); + _item.Precedence := PRECEDENCE_ATOM; + _item.Value := 'Ln(2)'; + _item._Type := 'Extended'; + FPush(@_item); + Exit; + end //fpatan else if DisaInfo.Mnem = 'fpatan' then Begin @@ -8231,6 +8533,31 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL _item._Type := 'Extended'; FSet(0, @_item); Exit; + End + //fxch + else if DisaInfo.Mnem = 'fxch' then + begin + reg1Idx := 1; + //fxch st(i) + if DisaInfo.OpNum = 1 then + begin + reg1Idx := DisaInfo.OpRegIdx[0] - 30; + //fxch st(0) == fxcg + if reg1Idx=0 then reg1Idx := 1; + end; + FXch(0, reg1Idx); + Exit; + end + //fyl2x + else if DisaInfo.Mnem = 'fyl2x' then + begin + InitItem(@_item); + _item.Value := GetString(FGet(1), PRECEDENCE_MULT) + ' * Log2(' + GetString(FGet(0), PRECEDENCE_NONE) + ')'; + _item._Type := 'Extended'; + _item.Precedence := PRECEDENCE_MULT; + FSet(1, @_item); + FPop; + Exit; End; Env.ErrAdr := curAdr; raise Exception.Create('Under construction'); @@ -8773,27 +9100,27 @@ function TDecompiler.DecompileTry(fromAdr:Integer; flags:TDecomCset; loopInfo:TL End; end; -Function TDecompiler.GetArrayFieldOffset (ATypeName:AnsiString; AFromOfs, AScale:Integer):FieldInfo; +function TDecompiler.GetArrayFieldOffset(ATypeName:AnsiString; AFromOfs, AScale:Integer;var _name,_type:AnsiString): Integer; var _vmt:Boolean; - _offset,classSize,_vmtAdr,_size,l_idx,h_idx,ofs:Integer; + _offset,classSize,_size,l_idx,h_idx,ofs,fofs:Integer; fInfo:FieldInfo; Begin - Result:=Nil; + Result:=-1; _offset:=AFromOfs; classSize := GetClassSize(GetClassAdr(ATypeName)); while True do begin if _offset >= classSize then break; - fInfo := FMain.GetField(ATypeName, _offset, _vmt, _vmtAdr); - if Assigned(fInfo) and (GetTypeKind(fInfo._Type, _size) = ikArray) - and GetArrayIndexes(fInfo._Type, 1, l_Idx, h_Idx) then + fofs:=GetField(ATypeName, _offset, _name, _type); + if (fofs>=0) and (GetTypeKind(_Type, _size) = ikArray) + and GetArrayIndexes(_Type, 1, l_Idx, h_Idx) then begin - _size := GetArrayElementTypeSize(fInfo._Type); + _size := GetArrayElementTypeSize(_Type); ofs := AFromOfs + AScale * l_Idx; - if (ofs >= fInfo.Offset) and (ofs <= fInfo.Offset + (h_Idx - l_Idx) * _size) then + if (ofs >= fofs) and (ofs <= fofs + (h_Idx - l_Idx) * _size) then begin - Result:=fInfo; + Result:=fofs; Exit; end; End; @@ -8810,6 +9137,7 @@ procedure TDecompiler.GetFloatItemFromStack(Esp:Integer; Dst:PITEM; FloatType:TF extVal:Extended; realVal:Real; compVal:Comp; + curVal:Currency; item:TItem; Begin InitItem(Dst); @@ -8855,6 +9183,14 @@ procedure TDecompiler.GetFloatItemFromStack(Esp:Integer; Dst:PITEM; FloatType:TF Dst.Value := FloatToStr(compVal); Dst._Type := 'Comp'; Exit; + end + Else if FloatType = FT_CURRENCY then + begin + curVal := 0; + MoveMemory(@curVal, @binData[0], 8); + Dst.Value := CurrToStr(curVal); + Dst._Type := 'Currency'; + Exit; end; item := Env.Stack[Esp + 8]; MoveMemory(@binData[8], @item.IntValue, 4); @@ -8876,12 +9212,11 @@ procedure TDecompiler.GetFloatItemFromStack(Esp:Integer; Dst:PITEM; FloatType:TF var _vmt:Boolean; kind:LKind; - offset, foffset, size, idx, idx1, _mod, k:Integer; + offset, foffset, size, idx, idx1, _mod, fofs, k:Integer; adr, vmtAdr:Integer; - recN:InfoRec; - fInfo:FieldInfo; + recN,recN1:InfoRec; item, itemBase, itemIndx:TItem; - _fname, _name, typeName, iname, _value, txt:AnsiString; + _fname, _name, _type, typeName, iname, _value, txt, varName:AnsiString; Begin InitItem(Dst); offset := DisaInfo.Offset; @@ -8929,21 +9264,29 @@ procedure TDecompiler.GetFloatItemFromStack(Esp:Integer; Dst:PITEM; FloatType:TF foffset := item.Offset; Dec(offset, foffset); _fname := GetRecordFields(foffset, Env.Stack[_ESP_ + offset]._Type); - _name := Env.GetLvarName(_ESP_ + offset); + typeName:=ExtractType(_fname); + _name := Env.GetLvarName(_ESP_ + offset, typeName); if Pos(':',_fname)<>0 then Begin Dst.Value := _name + '.' + ExtractName(_fname); - Dst._Type := ExtractType(_fname); + Dst._Type := typeName; End else Dst.Value := _name + '.f' + Val2Str(foffset); Dst.Name := Dst.Value; Exit; End; - _value := Env.GetLvarName(_ESP_ + offset); - if item.Value <> '' then _value := _value + 'Begin' + item.Value + 'End;'; + _value := Env.GetLvarName(_ESP_ + offset,''); + if item.Value <> '' then _value := _value + '{' + item.Value + '}'; Dst.Value := _value; Exit; End; + //lea reg, [ebp + N], bpBased + if (Op = OP_LEA) and (DisaInfo.BaseReg = 21) and (DisaInfo.IndxReg = -1) and Env.BpBased then + begin + Dst.Flags := [IF_STACK_PTR]; + Dst.IntValue := itemBase.IntValue + offset; + Exit; + end; //Embedded procedures if Env.Embedded then begin @@ -9005,7 +9348,7 @@ procedure TDecompiler.GetFloatItemFromStack(Esp:Integer; Dst:PITEM; FloatType:TF Exclude(item.Flags, IF_VAR); item._Type := '^' + item._Type; AssignItem(Dst^, item); - Dst.Name := Env.GetLvarName(itemBase.IntValue + offset); + Dst.Name := Env.GetLvarName(itemBase.IntValue + offset,''); Exit; End //Field @@ -9014,7 +9357,8 @@ procedure TDecompiler.GetFloatItemFromStack(Esp:Integer; Dst:PITEM; FloatType:TF foffset := item.Offset; Dec(offset, foffset); _fname := GetRecordFields(foffset, Env.Stack[itemBase.IntValue + offset]._Type); - _name := Env.GetLvarName(itemBase.IntValue + offset); + typeName:=ExtractType(_fname); + _name := Env.GetLvarName(itemBase.IntValue + offset, typeName); if Pos(':',_fname)<>0 then Begin Dst.Value := _name + '.' + ExtractName(_fname); @@ -9027,20 +9371,15 @@ procedure TDecompiler.GetFloatItemFromStack(Esp:Integer; Dst:PITEM; FloatType:TF //Not interface else if (item._Type = '') or (GetTypeKind(item._Type, size) <> ikInterface) then Begin - Env.Stack[itemBase.IntValue + offset].Name := Env.GetLvarName(itemBase.IntValue + offset); + varName:=Env.GetLvarName(itemBase.IntValue + offset,''); + Env.Stack[itemBase.IntValue + offset].Name := varName; Dst.Flags := [IF_STACK_PTR]; Dst.IntValue := itemBase.IntValue + offset; - Dst.Value := Env.GetLvarName(itemBase.IntValue + offset); + Dst.Value := varName; Dst.Name := Dst.Value; Exit; End; End - //lea - else if Op = OP_LEA then - Begin - //Dst.Value := GetDecompilerRegisterName(DisInfo.BaseReg) + ' + ' + String(_offset); - //return; - End //[BaseReg] else if offset = 0 then Begin @@ -9052,6 +9391,26 @@ procedure TDecompiler.GetFloatItemFromStack(Esp:Integer; Dst:PITEM; FloatType:TF Dst.Name := ''; Exit; End + else if IF_RECORD_FOFS in itemBase.Flags then + begin + _value := itemBase.Value; + if IF_ARRAY_PTR in itemBase.Flags then _value:=_value + '[]'; + txt := GetRecordFields(itemBase.Offset, itemBase._Type); + if Pos(':',txt)<>0 then + begin + _value:=_value + '.' + ExtractName(txt); + typeName := ExtractType(txt); + end + else + begin + _value:=_value + '.f' + Val2Str(itemBase.Offset); + typeName := txt; + end; + Dst.Value := _value; + Dst._Type := typeName; + Dst.Name := ''; + Exit; + end else if IF_ARRAY_PTR in itemBase.Flags then with Dst^ do Begin Value := itemBase.Value + '[]'; @@ -9081,6 +9440,8 @@ procedure TDecompiler.GetFloatItemFromStack(Esp:Integer; Dst:PITEM; FloatType:TF End else if typeName = '' then Begin + typeName:='Pointer'; + { _name := GetDecompilerRegisterName(DisaInfo.BaseReg); typeName := ManualInput(CurProcAdr, CurAdr, 'Define type of base register (' + _name + ')', 'Type:'); if typeName = '' then @@ -9088,6 +9449,7 @@ procedure TDecompiler.GetFloatItemFromStack(Esp:Integer; Dst:PITEM; FloatType:TF Env.ErrAdr := CurAdr; raise Exception.Create('Empty input - See you later!'); End; + } End else if typeName[1] = '^' then //Pointer to var Begin @@ -9166,6 +9528,26 @@ procedure TDecompiler.GetFloatItemFromStack(Esp:Integer; Dst:PITEM; FloatType:TF Dst.Value := _name + '[' + GetDecompilerRegisterName(DisaInfo.BaseReg) + ']'; Exit; End + else if IF_RECORD_FOFS in itemBase.Flags then + begin + _value := itemBase.Value; + if IF_ARRAY_PTR in itemBase.Flags then _value:=_value + '[]'; + txt := GetRecordFields(itemBase.Offset + offset, itemBase._Type); + if Pos(':',txt)<>0 then + begin + _value:=_value + '.' + ExtractName(txt); + typeName := ExtractType(txt); + end + else + begin + _value:=_value + '.f' + Val2Str(itemBase.Offset + offset); + typeName := txt; + end; + Dst.Value := _value; + Dst._Type := typeName; + Dst.Name := ''; + Exit; + end else if IF_ARRAY_PTR in itemBase.Flags then Begin if (IF_STACK_PTR in itemBase.Flags) and (Env.Stack[itemBase.IntValue].Value <> '') then @@ -9182,6 +9564,8 @@ procedure TDecompiler.GetFloatItemFromStack(Esp:Integer; Dst:PITEM; FloatType:TF typeName := itemBase._Type; if typeName = '' then Begin + typeName:='Pointer'; + { _name := GetDecompilerRegisterName(DisaInfo.BaseReg); typeName := ManualInput(CurProcAdr, CurAdr, 'Define type of base register (' + _name + ')', 'Type:'); if typeName = '' then @@ -9189,6 +9573,7 @@ procedure TDecompiler.GetFloatItemFromStack(Esp:Integer; Dst:PITEM; FloatType:TF Env.ErrAdr := CurAdr; raise Exception.Create('Empty input - See you later!'); End; + } End else if (typeName[1] = '^') then typeName := GetTypeDeref(typeName); @@ -9211,6 +9596,14 @@ procedure TDecompiler.GetFloatItemFromStack(Esp:Integer; Dst:PITEM; FloatType:TF _value := itemBase.Value else _value := GetDecompilerRegisterName(DisaInfo.BaseReg); + if Op = OP_LEA then //address of field with ofs=_offset in structure _typeName + begin + Dst.Flags := [IF_RECORD_FOFS]; + Dst.Value := _value; + Dst._Type := typeName; + Dst.Offset := offset; + Exit; + end; txt := GetRecordFields(offset, typeName); if Pos(':',txt)<>0 then Begin @@ -9278,24 +9671,27 @@ procedure TDecompiler.GetFloatItemFromStack(Esp:Integer; Dst:PITEM; FloatType:TF End else if (kind = ikVMT) or (kind = ikClass) then Begin - fInfo := FMain.GetField(typeName, offset, _vmt, vmtAdr); - if not Assigned(fInfo) then + fofs := GetField(typeName, offset, _name, _type); + if fofs < 0 then Begin - txt := ManualInput(CurProcAdr, CurAdr, 'Define correct type of field f' + Val2Str(offset), 'Type:'); + txt := ManualInput(CurProcAdr, CurAdr, 'Define correct type of field ' + typeName + '.f' + Val2Str(offset), 'Type:'); if txt = '' then Begin Env.ErrAdr := CurAdr; raise Exception.Create('Empty input - See you later!'); End; - fInfo := FMain.GetField(txt, offset, _vmt, vmtAdr); - if not Assigned(fInfo) then + recN1 := GetInfoRec(GetClassAdr(typeName)); + recN1.vmtInfo.AddField(0, 0, FIELD_PUBLIC, offset, -1, '', txt); + fofs := GetField(typeName, offset, _name, _type); + if fofs < 0 then Begin Env.ErrAdr := CurAdr; raise Exception.Create('Field f' + Val2Str(offset) + ' not found in specified type'); End; End; - _value := GetFieldName(fInfo); - typeName := fInfo._Type; + _value := _name; + typeName := _Type; + foffset := fofs; //if Op <> OP_LEA then Begin kind := GetTypeKind(typeName, size); @@ -9311,11 +9707,11 @@ procedure TDecompiler.GetFloatItemFromStack(Esp:Integer; Dst:PITEM; FloatType:TF //Record else if kind = ikRecord then Begin - txt := GetRecordFields(offset - fInfo.Offset, typeName); + txt := GetRecordFields(offset - fOffset, typeName); if txt = '' then Begin txt := ManualInput(CurProcAdr, CurAdr, 'Define [name:]type of field ' - + typeName + '.f' + Val2Str(offset - fInfo.Offset), '[Name]:Type:'); + + typeName + '.f' + Val2Str(offset - fOffset), '[Name]:Type:'); if txt = '' then Begin Env.ErrAdr := CurAdr; @@ -9335,7 +9731,7 @@ procedure TDecompiler.GetFloatItemFromStack(Esp:Integer; Dst:PITEM; FloatType:TF End //Array else if kind = ikArray then - _value := _value + '[ofs:=' + IntToStr(offset - fInfo.Offset) + ']'; + _value := _value + '[ofs:=' + IntToStr(offset - fOffset) + ']'; if not SameText(iname, 'Self') then _value := iname + '.' + _value; End; End; @@ -9364,13 +9760,13 @@ procedure TDecompiler.GetFloatItemFromStack(Esp:Integer; Dst:PITEM; FloatType:TF //esp if DisaInfo.BaseReg = 20 then Begin - Dst.Value := Env.GetLvarName(_ESP_ + offset + DisaInfo.Scale) + '[' + itemIndx.Value + ']'; + Dst.Value := Env.GetLvarName(_ESP_ + offset + DisaInfo.Scale,'') + '[' + itemIndx.Value + ']'; Exit; End //ebp else if (DisaInfo.BaseReg = 21) and (IF_STACK_PTR in itemBase.Flags) then Begin - Dst.Value := Env.GetLvarName(itemBase.IntValue + offset + DisaInfo.Scale) + '[' + itemIndx.Value + ']'; + Dst.Value := Env.GetLvarName(itemBase.IntValue + offset + DisaInfo.Scale,'') + '[' + itemIndx.Value + ']'; Exit; End; kind := ikUnknown; @@ -9391,12 +9787,15 @@ procedure TDecompiler.GetFloatItemFromStack(Esp:Integer; Dst:PITEM; FloatType:TF End; while (kind = ikUnknown) or (kind = ikData) do Begin + txt:='Pointer'; + { txt := ManualInput(CurProcAdr, CurAdr, 'Define type of base register', 'Type:'); if txt = '' then Begin Env.ErrAdr := CurAdr; raise Exception.Create('Empty input - See you later!'); End; + } typeName := txt; kind := GetTypeKind(typeName, size); End; @@ -9405,22 +9804,25 @@ procedure TDecompiler.GetFloatItemFromStack(Esp:Integer; Dst:PITEM; FloatType:TF Begin if typeName[1] = '^' then typeName := GetTypeDeref(typeName); kind := GetTypeKind(typeName, size); - while kind = ikUnknown do + while not (kind in [ikClass,ikVMT,ikLString,ikCString,ikPointer,ikRecord,ikArray,ikDynArray]) do Begin + txt:='Pointer'; + { txt := ManualInput(CurProcAdr, CurAdr, 'Define type of base register', 'Type:'); if txt = '' then Begin Env.ErrAdr := CurAdr; raise Exception.Create('Empty input - See you later!'); End; + } typeName := txt; kind := GetTypeKind(typeName, size); End; End; if (kind = ikClass) or (kind = ikVMT) then Begin - fInfo := GetArrayFieldOffset(typeName, offset, DisaInfo.Scale); - while not Assigned(fInfo) do + fofs := GetArrayFieldOffset(typeName, offset, DisaInfo.Scale, _name,_type); + while fofs < 0 do Begin txt := ManualInput(CurProcAdr, CurAdr, 'Define actual offset of array field', 'Offset (in hex):'); if txt = '' then @@ -9429,16 +9831,16 @@ procedure TDecompiler.GetFloatItemFromStack(Esp:Integer; Dst:PITEM; FloatType:TF raise Exception.Create('Empty input - See you later!'); End; offset := StrToIntDef('$'+Trim(txt),0); - fInfo := GetArrayFieldOffset(typeName, offset, DisaInfo.Scale); + fofs := GetArrayFieldOffset(typeName, offset, DisaInfo.Scale,_name,_type); End; if not SameText(itemBase.Value, 'Self') then _value := itemBase.Value + '.'; - if fInfo.Name <> '' then - _value := _value + fInfo.Name + if _Name <> '' then + _value := _value + _Name else - _value := _value + 'f' + Val2Str(fInfo.Offset); + _value := _value + 'f' + Val2Str(fofs); _value := _value + '[' + GetDecompilerRegisterName(DisaInfo.IndxReg) + ']'; Dst.Value := _value; - Dst._Type := GetArrayElementType(fInfo._Type); + Dst._Type := GetArrayElementType(_Type); Exit; End; if (kind = ikLString) or (kind = ikCString) or (kind = ikPointer) then @@ -9650,7 +10052,7 @@ procedure TDecompiler.GetFloatItemFromStack(Esp:Integer; Dst:PITEM; FloatType:TF if IF_STACK_PTR in item.Flags then Begin Env.Stack[item.IntValue]._Type := 'String'; - Result:= Env.GetLvarName(item.IntValue); + Result:= Env.GetLvarName(item.IntValue,'String'); Exit; End else if IF_INTVAL in item.Flags then @@ -9705,7 +10107,7 @@ procedure TDecompiler.GetFloatItemFromStack(Esp:Integer; Dst:PITEM; FloatType:TF else Result:= item.Value; end; -Function TDecompiler.AnalyzeConditions (brType:Integer; curAdr, sAdr, jAdr:Integer; loopInfo:TLoopInfo):Integer; +function TDecompiler.AnalyzeConditions(brType:Integer; curAdr, sAdr, jAdr:Integer; loopInfo:TLoopInfo;bFloat:Boolean): Integer; var _begAdr, _bodyBegAdr, _bodyEndAdr, _jmpAdr,_curAdr:Integer; de:TDecompiler; @@ -9716,6 +10118,7 @@ procedure TDecompiler.GetFloatItemFromStack(Esp:Integer; Dst:PITEM; FloatType:TF //simple if if brType = 0 then Begin + if bFloat then SimulateFloatInstruction(sAdr); if CompInfo.O = 'R' then //not in _line := 'if (not (' + CompInfo.L + ' in ' + CompInfo.R + ')) then' else @@ -9824,6 +10227,7 @@ procedure TDecompiler.GetFloatItemFromStack(Esp:Integer; Dst:PITEM; FloatType:TF //cycle else if brType = 2 then Begin + if bFloat then SimulateFloatInstruction(sAdr); if CompInfo.O = 'R' then //not in _line := 'if (not (' + CompInfo.L + ' in ' + CompInfo.R + ')) then' else @@ -9852,6 +10256,7 @@ procedure TDecompiler.GetFloatItemFromStack(Esp:Integer; Dst:PITEM; FloatType:TF //simple if else else if brType = 3 then Begin + if bFloat then SimulateFloatInstruction(sAdr); if CompInfo.O = 'R' then //not in _line := 'if (not (' + CompInfo.L + ' in ' + CompInfo.R + ')) then' else @@ -9899,6 +10304,7 @@ procedure TDecompiler.GetFloatItemFromStack(Esp:Integer; Dst:PITEM; FloatType:TF End else Begin + if bFloat then SimulateFloatInstruction(sAdr); _line := 'if (' + CompInfo.L + ' ' + GetDirectCondition(CompInfo.O) + ' ' + CompInfo.R + ') then Break;'; Env.AddToBody(_line); End; diff --git a/Def_decomp.pas b/Def_decomp.pas index f38473c..9a8c230 100644 --- a/Def_decomp.pas +++ b/Def_decomp.pas @@ -14,7 +14,8 @@ interface IF_ARRAY_PTR, // 128; IF_INTVAL, // 256; IF_INTERFACE, // 512; - IF_EXTERN_VAR // 1024; // Used for embedded procedures + IF_EXTERN_VAR, // 1024; // Used for embedded procedures + IF_RECORD_FOFS // 2048; // Offset inside record ); TDecomIset = Set of TDecomIflag; @@ -31,11 +32,12 @@ interface Const //Precedence of operations - PRECEDENCE_ATOM = 8; - PRECEDENCE_NOT = 4; //@,not - PRECEDENCE_MULT = 3; //*,/,div, mod,and,shl,shr,as - PRECEDENCE_ADD = 2; //+,-,or,xor - PRECEDENCE_CMP = 1; //=,<>,<,>,<=,>=,in,is + PRECEDENCE_ATOM = 24; + PRECEDENCE_UNARY = 16; + PRECEDENCE_MULT = 15; //*,/,div, mod,and,shl,shr,as + PRECEDENCE_ADD = 14; //+,-,or,xor + PRECEDENCE_NOT = 6; //@,not + PRECEDENCE_CMP = 9; //=,<>,<,>,<=,>=,in,is PRECEDENCE_NONE = 0; TAB_SIZE = 2; @@ -132,7 +134,8 @@ TCaseTreeNode = record DContext = record adr:Integer; gregs:Regs; //general registers - fregs:Regs; //float point registers + fregs:Regs; //floating point registers + fregsd:Regs; //floating point registers (copy) End; PDContext = ^DContext; diff --git a/Def_disasm.pas b/Def_disasm.pas index b0ea930..0b7dc99 100644 --- a/Def_disasm.pas +++ b/Def_disasm.pas @@ -98,7 +98,7 @@ TDisInfo = record Offset:Integer; //ImmPresent:Boolean; Immediate:Integer; - MemSize:Integer; + OpSize:Byte; sSize:String[32]; RepPrefix:Integer; SegPrefix:Integer; diff --git a/Def_know.pas b/Def_know.pas index b9be8e6..cbd9390 100644 --- a/Def_know.pas +++ b/Def_know.pas @@ -144,11 +144,11 @@ FieldInfo = class //FIELDINFO():xrefs(0){} //~FIELDINFO(); Scope:Byte; //9-private, 10-protected, 11-public, 12-published - Offset:Integer; //Offset in the object + Offset:Integer; //Offset in class instance _Case:Integer; //case for record types (0xFFFFFFFF for the rest) Name:AnsiString; //Field name _Type:AnsiString; //Field type - xrefs:TList; //References to this field from the CODE section + xrefs:TList; //XRefs to this field from the CODE section Constructor Create; Destructor Destroy; Override; End; @@ -220,14 +220,14 @@ MTypeInfo = record Kind:Byte; //drArrayDef,...,drVariantDef VMCnt:WORD; //Number of elements in VMT (indexed from 0) Decl:AnsiString; //Declaration - DumpSz, //Размер бинарного дампа - FixupNum:Integer; //Количество фиксапов дампа - Dump:PAnsiChar; //Бинарный дамп - FieldsNum:WORD; //Количество полей (class, interface, record) + DumpSz, //Binary dump size + FixupNum:Integer; //Binary dump fixup number + Dump:PAnsiChar; //Binary dump + FieldsNum:WORD; //Number of fields (class, interface, record) Fields:PAnsiChar; - PropsNum:WORD; //Количество свойств (class, interface) + PropsNum:WORD; //Number of properties (class, interface) Props:PAnsiChar; - MethodsNum:WORD; //Количество методов (class, interface) + MethodsNum:WORD; //Number of methods (class, interface) Methods:PAnsiChar; //Constructor Create; end; @@ -239,7 +239,7 @@ MVarInfo = record VarName:AnsiString; _Type:Byte; //'V'-Var;'A'-AbsVar;'S'-SpecVar;'T'-ThreadVar TypeDef:AnsiString; - AbsName:AnsiString; //Для ключевого слова absolute + AbsName:AnsiString; //for the "absolute" keyword //Constructor Create; end; PMVarInfo = ^MVarInfo; @@ -277,6 +277,8 @@ MProcInfo = record Const + SCOPE_TMP = 32; // Temp struct FIELDINFO, to be deleted + // Description of the Kind values drArrayDef = $4C; //'L' drClassDef = $46; //'F' diff --git a/Def_main.pas b/Def_main.pas index 9c64f39..cc14ce4 100644 --- a/Def_main.pas +++ b/Def_main.pas @@ -9,7 +9,7 @@ interface TChars = Set of Char; //Float Type - TFloatKind = (FT_NONE, FT_SINGLE, FT_DOUBLE, FT_EXTENDED, FT_REAL, FT_COMP); + TFloatKind = (FT_NONE, FT_SINGLE, FT_DOUBLE, FT_EXTENDED, FT_REAL, FT_COMP, FT_CURRENCY); TUnit_type = ( ut_Trivial, //Trivial unit ut_User, //User unit @@ -149,6 +149,11 @@ SegmentInfo = record End; PSegmentInfo = ^SegmentInfo; + CaseInfo = record + caseNo,count:Integer; + end; + PCaseInfo = ^CaseInfo; + FuncListRec = record name:AnsiString; codeOfs:Integer; diff --git a/Def_thread.pas b/Def_thread.pas index b2c6ad8..e971f80 100644 --- a/Def_thread.pas +++ b/Def_thread.pas @@ -8,7 +8,7 @@ interface Type ThreadAnalysisOperation = ( - taStartPrBar, taUpdatePrBar, taStopPrBar, taUpdateStBar, + taStartPrBar, taUpdatePrBar, taStopPrBar, taUpdateStBar, taUpdateUnits, taUpdateRTTIs, taUpdateVmtList, taUpdateStrings, taUpdateCode, taUpdateXrefs, taUpdateShortClassViewer, taUpdateClassViewer, taUpdateBeforeClassViewer, taFinished diff --git a/Disasm.pas b/Disasm.pas index 1b4871a..00893c8 100644 --- a/Disasm.pas +++ b/Disasm.pas @@ -627,7 +627,7 @@ function MDisasm.GetOp(mnem:AnsiString): Byte; if sptr<>'' then begin if Assigned(disLine) then disLine^:=disLine^ + sptr + ' ptr '; - DisInfo.MemSize := size; + DisInfo.OpSize := size; DisInfo.sSize:=sptr; End; end; diff --git a/EditFieldsDlg.pas b/EditFieldsDlg.pas index 105b366..126aaec 100644 --- a/EditFieldsDlg.pas +++ b/EditFieldsDlg.pas @@ -216,7 +216,7 @@ procedure TFEditFieldsDlg.bApplyClick(Sender : TObject); recN := GetInfoRec(VmtAdr); if Op = FD_OP_ADD then begin - fInfo := FMain.GetField(recN.Name, offset, vmt, adr); + fInfo := FMain.GetField(recN.Name, offset, vmt, adr,''); if Not Assigned(fInfo) Then if Application.MessageBox('Field already exists', 'Replace?', MB_YESNO) = IDYES then recN.vmtInfo.AddField(0, 0, FIELD_PUBLIC, offset, -1, edtName.text, edtType.text); diff --git a/EditFunctionDlg.dfm b/EditFunctionDlg.dfm index f84f6ad..49723e5 100644 --- a/EditFunctionDlg.dfm +++ b/EditFunctionDlg.dfm @@ -42,14 +42,14 @@ object FEditFunctionDlg: TFEditFunctionDlg TabOrder = 1 OnClick = bAddClick end - object bRemove: TButton + object bRemoveSelected: TButton Left = 212 Top = 5 - Width = 75 + Width = 100 Height = 25 - Caption = 'Remove' + Caption = 'Remove Selected' TabOrder = 2 - OnClick = bRemoveClick + OnClick = bRemoveSelectedClick end object bOk: TButton Left = 625 @@ -61,6 +61,15 @@ object FEditFunctionDlg: TFEditFunctionDlg TabOrder = 3 OnClick = bOkClick end + object bRemoveAll: TButton + Left = 368 + Top = 5 + Width = 97 + Height = 25 + Caption = 'Remove All' + TabOrder = 4 + OnClick = bRemoveAllClick + end end object pc: TPageControl Left = 0 @@ -314,23 +323,26 @@ object FEditFunctionDlg: TFEditFunctionDlg object lbVars: TListBox Left = 0 Top = 0 - Width = 777 - Height = 137 + Width = 705 + Height = 298 + Align = alClient Font.Charset = RUSSIAN_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'Fixedsys' Font.Style = [] ItemHeight = 16 + MultiSelect = True ParentFont = False TabOrder = 0 OnClick = lbVarsClick end object pnlVars: TPanel Left = 0 - Top = 143 - Width = 777 + Top = 298 + Width = 705 Height = 146 + Align = alBottom TabOrder = 1 object rgLocBase: TRadioGroup Left = 260 diff --git a/EditFunctionDlg.pas b/EditFunctionDlg.pas index a9d7761..015f595 100644 --- a/EditFunctionDlg.pas +++ b/EditFunctionDlg.pas @@ -12,7 +12,7 @@ TFEditFunctionDlg=class(TForm) Panel1: TPanel; bEdit: TButton; bAdd: TButton; - bRemove: TButton; + bRemoveSelected: TButton; pc: TPageControl; tsArgs: TTabSheet; lbArgs: TListBox; @@ -42,6 +42,7 @@ TFEditFunctionDlg=class(TForm) lArgsBytes: TLabel; lEndAdr: TLabeledEdit; lStackSize: TLabeledEdit; + bRemoveAll: TButton; procedure FormKeyDown(Sender : TObject; var Key:Word; Shift: TShiftState); procedure bEditClick(Sender : TObject); procedure FormShow(Sender : TObject); @@ -49,11 +50,12 @@ TFEditFunctionDlg=class(TForm) procedure lbVarsClick(Sender : TObject); procedure bCancelVarClick(Sender : TObject); procedure bApplyVarClick(Sender : TObject); - procedure bRemoveClick(Sender : TObject); + procedure bRemoveSelectedClick(Sender : TObject); procedure bAddClick(Sender : TObject); procedure bApplyTypeClick(Sender : TObject); procedure bCancelTypeClick(Sender : TObject); procedure bOkClick(Sender : TObject); + procedure bRemoveAllClick(Sender: TObject); procedure FormClose(Sender : TObject; var Action:TCloseAction); procedure cbMethodClick(Sender : TObject); private @@ -61,7 +63,7 @@ TFEditFunctionDlg=class(TForm) TypModified:Boolean; VarModified:Boolean; //ArgEdited:Integer; - VarEdited:Integer; + //VarEdited:Integer; VmtCandidatesNum:Integer; StackSize:Integer; SFlags:TProcFlagSet; @@ -83,7 +85,7 @@ implementation {$R *.DFM} -Uses Infos,Misc,StrUtils,Def_main,Main,Def_know; +Uses Types,Infos,Misc,StrUtils,Def_main,Main,Def_know; procedure TFEditFunctionDlg.bOkClick(Sender : TObject); begin @@ -139,7 +141,8 @@ procedure TFEditFunctionDlg.FormShow(Sender : TObject); //Buttons bEdit.Enabled := true; bAdd.Enabled := false; - bRemove.Enabled := false; + bRemoveSelected.Enabled := false; + bRemoveAll.Enabled := false; bOk.Enabled := false; TypModified := false; @@ -149,6 +152,8 @@ procedure TFEditFunctionDlg.FormShow(Sender : TObject); procedure TFEditFunctionDlg.bEditClick(Sender : TObject); var line,p:AnsiString; + recN:InfoRec; + locInfo:PLocalInfo; begin if pc.ActivePage = tsType then begin @@ -168,6 +173,16 @@ procedure TFEditFunctionDlg.bEditClick(Sender : TObject); edtVarOfs.Text := ''; edtVarName.Text := ''; edtVarType.Text := ''; + recN:=GetInfoRec(Adr); + locInfo:=recN.procInfo.locals[lbVars.ItemIndex]; + If Assigned(locInfo) Then + begin + edtVarOfs.Text:=IntToHex(locInfo.Ofs,0); + edtVarSize.Text:=IntToStr(locInfo.Size); + edtVarName.Text:=locInfo.Name; + edtVarType.Text:=locInfo.TypeDef; + end; + { line := lbVars.Items[lbVars.ItemIndex]; p := StrTok(line,[' ']); if p='' then Exit; @@ -187,6 +202,7 @@ procedure TFEditFunctionDlg.bEditClick(Sender : TObject); if p<>'?' then edtVarType.Text := p; VarEdited := lbVars.ItemIndex; lbVars.Align := alNone; + } lbVars.Height := pc.Height - pnlVars.Height; pnlVars.Visible := true; end; @@ -195,13 +211,15 @@ procedure TFEditFunctionDlg.bEditClick(Sender : TObject); //Buttons bEdit.Enabled := false; bAdd.Enabled := false; - bRemove.Enabled := false; + bRemoveSelected.Enabled := false; + bRemoveAll.Enabled := false; end; procedure TFEditFunctionDlg.lbVarsClick(Sender : TObject); begin - bEdit.Enabled := (lbVars.Count > 0) and (lbVars.ItemIndex <> -1); - bRemove.Enabled := (lbVars.Count > 0) and (lbVars.ItemIndex <> -1); + bEdit.Enabled := lbVars.SelCount = 1; + bRemoveSelected.Enabled := (lbVars.SelCount > 0); + bRemoveAll.Enabled := lbVars.Count > 0 end; procedure TFEditFunctionDlg.pcChange(Sender : TObject); @@ -210,20 +228,23 @@ procedure TFEditFunctionDlg.pcChange(Sender : TObject); begin bEdit.Enabled := true; bAdd.Enabled := false; - bRemove.Enabled := false; + bRemoveSelected.Enabled := false; + bRemoveAll.Enabled := False; end else if pc.ActivePage = tsArgs then begin bEdit.Enabled := false; bAdd.Enabled := false; - bRemove.Enabled := false; + bRemoveSelected.Enabled := false; + bRemoveAll.Enabled := false; end else begin - bEdit.Enabled := (lbVars.Count > 0) and (lbVars.ItemIndex <> -1); bAdd.Enabled := false; - bRemove.Enabled := (lbVars.Count > 0) and (lbVars.ItemIndex <> -1); - End; + bEdit.Enabled := (lbVars.SelCount = 1); + bRemoveSelected.Enabled := (lbVars.SelCount > 0); + bRemoveAll.Enabled := (lbVars.Count > 0); + End; end; procedure TFEditFunctionDlg.bApplyTypeClick(Sender : TObject); @@ -353,7 +374,8 @@ procedure TFEditFunctionDlg.bApplyTypeClick(Sender : TObject); //Buttons bEdit.Enabled:=true; bAdd.Enabled:=false; - bRemove.Enabled:=false; + bRemoveSelected.Enabled:=false; + bRemoveAll.Enabled:=false; bOk.Enabled:=true; TypModified:=true; @@ -383,19 +405,25 @@ procedure TFEditFunctionDlg.bCancelTypeClick(Sender : TObject); //Buttons bEdit.Enabled := true; bAdd.Enabled := false; - bRemove.Enabled := false; + bRemoveSelected.Enabled := false; + bRemoveAll.Enabled:=False; bOk.Enabled := false; TypModified := false; end; procedure TFEditFunctionDlg.bApplyVarClick(Sender : TObject); Var - line,item:AnsiString; - n:Integer; + recofs,size,pos1,pos2,elofs,len1:Integer; + recFile:TextFile; + p:PAnsiChar; + fname,ftype,_name,_type,recFileName,ofs,str:AnsiString; + recN:InfoRec; + locInfo:PLocalInfo; + tInfo:MTypeInfo; + _uses:TWordDynArray; begin try - n := StrToInt(Trim(edtVarOfs.Text)); - line := ' ' + Val2Str(n,4) + ' '; // offset + recofs := StrToInt('$'+Trim(edtVarOfs.Text)); Except on E:Exception do begin @@ -405,8 +433,7 @@ procedure TFEditFunctionDlg.bApplyVarClick(Sender : TObject); End; End; try - n := StrToInt(Trim(edtVarSize.Text)); - line :=line + Val2Str(n,2) + ' '; // size + size := StrToInt('$'+Trim(edtVarSize.Text)); Except on E:Exception do begin @@ -415,6 +442,7 @@ procedure TFEditFunctionDlg.bApplyVarClick(Sender : TObject); Exit; end; End; + { item := edtVarName.Text; if item <> '' then line:=line + item else line:=line + '?'; @@ -425,13 +453,103 @@ procedure TFEditFunctionDlg.bApplyVarClick(Sender : TObject); lbVars.Items[VarEdited] := line; lbVars.Update; + } + + //Insert by ZGL + recN := GetInfoRec(Adr); + locInfo := recN.procInfo.locals[lbVars.ItemIndex]; + //////////// + + recofs := locInfo.Ofs; + fname := Trim(edtVarName.Text); + locInfo.Name := fname; //ZGL add + ftype := Trim(edtVarType.Text); + locInfo.TypeDef := ftype; //ZGL add + recN.procInfo.SetLocalType(recofs, ftype); + + if (ftype <> '') and (GetTypeKind(ftype, size) = ikRecord) then + begin + recFileName := FMain.WrkDir + '\types.idr'; + if FileExists(recFileName) then + begin + AssignFile(recFile,recFileName); + Reset(recFile); + while Not Eof(recFile) do + begin + ReadLn(recFile,str); + if Pos(ftype + '=',str) = 1 then + begin + while not eof(recFile) do + begin + ReadLn(recFile,str); + if Pos('end;',str)<>0 then break; + pos2 := Pos('//',str); + if pos2<>0 then + begin + ofs := Copy(str,pos2 + 2, Length(str)); + pos1 := Pos(':',str); + if pos1<>0 then + begin + _name := Copy(str,1, pos1 - 1); + _type := Copy(str,pos1 + 1, pos2 - pos1 - 1); + recN.procInfo.AddLocal(StrToInt('$' + ofs) + recofs, 1, fname + '.' + _name, _type); + end; + End; + end; + end; + end; + CloseFile(recFile); + End; + while True do + begin + //KB + _uses := KBase.GetTypeUses(PAnsiChar(ftype)); + pos1 := KBase.GetTypeIdxByModuleIds(_uses, PAnsiChar(ftype)); + _uses:=Nil; + if pos1 = -1 then break; + + pos1 := KBase.TypeOffsets[pos1].NamId; + if KBase.GetTypeInfo(pos1, [INFO_FIELDS], tInfo) then + begin + if tInfo.FieldsNum<>0 then + begin + p := tInfo.Fields; + for pos2:=0 to tInfo.FieldsNum-1 do + begin + //Scope + Inc(p); + elofs := PInteger(p)^; + Inc(p, 4); + Inc(p, 4);//case + //Name + len1 := PWord(p)^; + Inc(p, 2); + _name := MakeString(p, len1); + Inc(p, len1 + 1); + //Type + len1 := PWord(p)^; + Inc(p, 2); + _type := TrimTypeName(MakeString(p, len1)); + Inc(p, len1 + 1); + recN.procInfo.AddLocal(recofs + elofs, 1, fname + '.' + _name, _type); + end; + break; + end; + if tInfo.Decl <> '' then ftype := tInfo.Decl; + end; + end; + end; + + FillVars; + pnlVars.Visible := false; - lbVars.Align := alClient; lbVars.Enabled := true; lbArgs.Enabled := true; + bEdit.Enabled := true; bAdd.Enabled := false; - bRemove.Enabled := false; + bRemoveSelected.Enabled := false; + bRemoveAll.Enabled := false; bOk.Enabled := true; VarModified := true; end; @@ -439,24 +557,31 @@ procedure TFEditFunctionDlg.bApplyVarClick(Sender : TObject); procedure TFEditFunctionDlg.bCancelVarClick(Sender : TObject); begin pnlVars.Visible := false; - lbVars.Align := alClient; lbVars.Enabled := true; lbArgs.Enabled := true; bOk.Enabled := false; VarModified := false; end; -procedure TFEditFunctionDlg.bRemoveClick(Sender : TObject); +procedure TFEditFunctionDlg.bRemoveSelectedClick(Sender : TObject); var recN:InfoRec; + locInfo:PLocalInfo; + n:Integer; begin if pc.ActivePage = tsVars then begin recN := GetInfoRec(Adr); - recN.procInfo.DeleteLocal(lbVars.ItemIndex); + for n:=lbVars.Count-1 downto 0 do + if lbVars.Selected[n] Then + begin + locInfo:=recN.procInfo.locals[n]; + recN.procInfo.DeleteLocal(n); + end; FillVars; - bEdit.Enabled := (lbVars.Count > 0) and (lbVars.ItemIndex <> -1); - bRemove.Enabled := (lbVars.Count > 0) and (lbVars.ItemIndex <> -1); + bEdit.Enabled := false; + bRemoveSelected.Enabled := false; + bRemoveAll.Enabled:=(lbVars.Count > 0); end; end; @@ -552,7 +677,6 @@ procedure TFEditFunctionDlg.bAddClick(Sender : TObject); canva := lbArgs.Canvas; maxwid := 0; cnt := recN.procInfo.args.Count; - //recN.procInfo.args.Sort(ArgsCmpFunction); callKind := recN.procInfo.call_kind; if (callKind = 1) or (callKind = 3) then //cdecl, stdcall begin @@ -652,7 +776,7 @@ procedure TFEditFunctionDlg.bAddClick(Sender : TObject); for n := 0 to cnt-1 do begin locInfo := recN.procInfo.locals.Items[n]; - line := Val2Str(-locInfo.Ofs,4) + ' ' + Val2Str(locInfo.Size,2) + ' '; + line := Val2Str(-locInfo.Ofs,8) + ' ' + Val2Str(locInfo.Size,2) + ' '; if locInfo.Name <> '' then line:=line + locInfo.Name else line:=line + '?'; line:=line + ':'; @@ -700,4 +824,19 @@ procedure TFEditFunctionDlg.cbMethodClick(Sender : TObject); End; end; +procedure TFEditFunctionDlg.bRemoveAllClick(Sender: TObject); +var + recN:InfoRec; +begin + recN:=GetInfoRec(Adr); + If Assigned(recN.procInfo.locals) Then + Begin + recN.procInfo.DeleteLocals; + FillVars; + bEdit.Enabled:=False; + bRemoveSelected.Enabled:=False; + bRemoveAll.Enabled:=false; + end; +end; + end. diff --git a/Heuristic.pas b/Heuristic.pas index a4524cd..c170602 100644 --- a/Heuristic.pas +++ b/Heuristic.pas @@ -61,12 +61,8 @@ implementation frmDisasm.Disassemble(Pos2Adr(p), @disInfo, Nil); if disInfo.Branch then begin - if IsExit(disInfo.Immediate) then - begin - Result:= 0; - Exit; - end; - if disInfo.Conditional then + if IsExit(disInfo.Immediate) then Result:= 0 + else if disInfo.Conditional then begin if disInfo.Immediate > Integer(CodeBase) + p then begin @@ -75,31 +71,25 @@ implementation End else Result:=2; End - Else + Else if disInfo.Immediate > Integer(CodeBase) + p then begin - if disInfo.Immediate > Integer(CodeBase) + p then + jmpAdr := disInfo.Immediate; + Result:=3; + End + Else if IsFlagSet([cfFinally], p) then + begin + //jmp after jmp @HandleFinally + p := GetNearestUpInstruction(Adr2Pos(disInfo.Immediate)); + //push Adr + frmDisasm.Disassemble(Pos2Adr(p), @disInfo, Nil); + if disInfo.Immediate = fromAdr Then Result:=0 + Else begin jmpAdr := disInfo.Immediate; Result:=3; - End - Else - begin - //jmp after jmp @HandleFinally - if IsFlagSet([cfFinally], p) then - begin - p := GetNearestUpInstruction(Adr2Pos(disInfo.Immediate)); - //push Adr - frmDisasm.Disassemble(Pos2Adr(p), @disInfo, Nil); - if disInfo.Immediate = fromAdr Then Result:=0 - Else - begin - jmpAdr := disInfo.Immediate; - Result:=3; - End; - End - else Result:=4; End; - End; + End + else Result:=4; End else Result:=0; end; diff --git a/IDCGen.pas b/IDCGen.pas index 6d34664..468a020 100644 --- a/IDCGen.pas +++ b/IDCGen.pas @@ -2,7 +2,7 @@ Interface -Uses Classes,Def_main,Infos; +Uses Windows,Messages,Classes,Def_main,Infos,Dialogs; Type TIDCGen = class @@ -12,8 +12,12 @@ TIDCGen = class itemName:AnsiString; names:TStringList; repeated:TList; - Constructor Create(f:TFileStream); + SplitSize:Integer; // Maximum output bytes if IDC splitted + CurrentPartNo:Integer; // current part number (filename looks like XXX_NN.idc) + CurrentBytes:Integer; // current part output bytes + constructor Create(f:TFileStream;AsplitSize:Integer); Destructor Destroy; Override; + procedure NewIDCPart(f:TFileStream); Procedure DeleteName(_pos:Integer); Function MakeByte(_pos:Integer):Integer; Function MakeWord(_pos:Integer):Integer; @@ -29,7 +33,8 @@ TIDCGen = class Procedure MakeFunction(adr:Integer); Procedure MakeComment(_pos:Integer; text:AnsiString); Function OutputAttrData(_pos:Integer):Integer; - Procedure OutputHeader; + Procedure OutputHeaderFull; + Procedure OutputHeaderShort; Function OutputRTTIHeader(kind:LKind; _pos:Integer):Integer; Procedure OutputRTTIInteger(kind:LKind; _pos:Integer); Procedure OutputRTTIChar(kind:LKind; _pos:Integer); @@ -71,15 +76,26 @@ TIDCGen = class Function GetNameInfo(idx:Integer):PRepNameInfo; end; + TSaveIDCDialog = class(TOpenDialog) + Constructor Create(AOwner:TComponent); + procedure WndProc(var Msg:TMessage); Override; + end; + Implementation Uses Misc,SysUtils,Main,Def_disasm; -Constructor TIDCGen.Create (f:TFileStream); +Const + chkSplit_ID = 101; + +constructor TIDCGen.Create(f:TFileStream;AsplitSize:Integer); Begin idcF:=f; names:=TStringList.Create; repeated:=TList.Create; + splitSize:=AsplitSize; + CurrentPartNo:=1; + CurrentBytes:=0; end; Destructor TIDCGen.Destroy; @@ -89,6 +105,13 @@ TIDCGen = class inherited; end; +procedure TIDCGen.NewIDCPart(f:TFileStream); +Begin + idcF:=f; + CurrentBytes:=0; + Inc(CurrentPartNo); +end; + Procedure TIDCGen.DeleteName (_pos:Integer); var adr:Integer; @@ -97,6 +120,7 @@ TIDCGen = class adr := Pos2Adr(_pos); s:=Format('MakeUnkn(0x%x, 1);'+#13+'MakeNameEx(0x%x, "", 0);'+#13,[adr,adr]); idcF.Write(s[1],Length(s)); + Inc(CurrentBytes,Length(s)); end; Function TIDCGen.MakeByte (_pos:Integer):Integer; @@ -105,6 +129,7 @@ TIDCGen = class Begin s:=Format('MakeByte(0x%x);'+#13,[Pos2Adr(_pos)]); idcF.Write(s[1],Length(s)); + Inc(CurrentBytes,Length(s)); Result:=_pos + 1; end; @@ -114,6 +139,7 @@ TIDCGen = class Begin s:=Format('MakeWord(0x%x);'+#13,[Pos2Adr(_pos)]); idcF.Write(s[1],Length(s)); + Inc(CurrentBytes,Length(s)); Result:=_pos + 2; end; @@ -123,6 +149,7 @@ TIDCGen = class Begin s:=Format('MakeDword(0x%x);'+#13,[Pos2Adr(_pos)]); idcF.Write(s[1],Length(s)); + Inc(CurrentBytes,Length(s)); Result:=_pos + 4; end; @@ -132,6 +159,7 @@ TIDCGen = class Begin s:=Format('MakeQword(0x%x);'+#13,[Pos2Adr(_pos)]); idcF.Write(s[1],Length(s)); + Inc(CurrentBytes,Length(s)); Result:=_pos + 8; end; @@ -143,6 +171,7 @@ TIDCGen = class adr:=Pos2Adr(_pos); s:=Format('MakeByte(0x%x);'+#13+'MakeArray(0x%x, %d);'+#13,[adr,adr,num]); idcF.Write(s[1],Length(s)); + Inc(CurrentBytes,Length(s)); Result:=_pos + num; end; @@ -161,6 +190,7 @@ TIDCGen = class adr:=Pos2Adr(_pos); s:=Format('SetLongPrm(INF_STRTYPE, ASCSTR_PASCAL);'+#13+'MakeStr(0x%x, 0x%x);'+#13,[adr,adr+len+1]); idcF.Write(s[1],Length(s)); + Inc(CurrentBytes,Length(s)); Result:=_pos + len + 1; End; end; @@ -175,6 +205,7 @@ TIDCGen = class len:=StrLen(Code + _pos); s:=Format('SetLongPrm(INF_STRTYPE, ASCSTR_TERMCHR);'+#13+'MakeStr(0x%x, 0x%x);'+#13,[adr,adr+len+1]); idcF.Write(s[1],Length(s)); + Inc(CurrentBytes,Length(s)); Result:=_pos + len + 1; end; @@ -184,6 +215,7 @@ TIDCGen = class Begin s:=Format('SetLongPrm(INF_STRTYPE, ASCSTR_TERMCHR);'+#13+'MakeStr(0x%x, -1);'+#13,[Pos2Adr(_pos)]); idcF.Write(s[1],Length(s)); + Inc(CurrentBytes,Length(s)); //Length MakeDword(_pos - 4); //RefCount @@ -196,6 +228,7 @@ TIDCGen = class Begin s:=Format('SetLongPrm(INF_STRTYPE, ASCSTR_UNICODE);'+#13+'MakeStr(0x%x, -1);'+#13,[Pos2Adr(_pos)]); idcF.Write(s[1],Length(s)); + Inc(CurrentBytes,Length(s)); //Length MakeDword(_pos - 4); end; @@ -206,6 +239,7 @@ TIDCGen = class Begin s:=Format('SetLongPrm(INF_STRTYPE, ASCSTR_UNICODE);'+#13+'MakeStr(0x%x, -1);'+#13,[Pos2Adr(_pos)]); idcF.Write(s[1],Length(s)); + Inc(CurrentBytes,Length(s)); //Length MakeDword(_pos - 4); //RefCount @@ -222,6 +256,7 @@ TIDCGen = class Begin s:=Format('MakeCode(0x%x);'+#13,[Pos2Adr(_pos)]); idcF.Write(s[1],Length(s)); + Inc(CurrentBytes,Length(s)); Result := frmDisasm.Disassemble(Code + _pos, Pos2Adr(_pos),Nil, Nil); if Result=0 then Result := 1; end; @@ -234,6 +269,7 @@ TIDCGen = class Begin s:=Format('MakeFunction(0x%x, -1);'+#13,[adr]); idcF.Write(s[1],Length(s)); + Inc(CurrentBytes,Length(s)); MakeCode(Adr2Pos(adr)); end; end; @@ -244,6 +280,7 @@ TIDCGen = class Begin s:=Format('MakeComm(0x%x, "%s");'+#13,[Pos2Adr(_pos), text]); idcF.Write(s[1],Length(s)); + Inc(CurrentBytes,Length(s)); end; Function TIDCGen.OutputAttrData (_pos:Integer):Integer; @@ -255,7 +292,7 @@ TIDCGen = class Result:=_pos; end; -Procedure TIDCGen.OutputHeader; +Procedure TIDCGen.OutputHeaderFull; var s:AnsiString; Begin @@ -278,6 +315,16 @@ TIDCGen = class +'clear(0x%lX);' ,[CodeBase]); idcF.Write(s[1],Length(s)); + Inc(CurrentBytes,Length(s)); +end; + +procedure TIDCGen.OutputHeaderShort; +var + s:AnsiString; +Begin + s:='#include '+#13+'static main(){'+#13; + idcF.Write(s[1],Length(s)); + Inc(CurrentBytes,Length(s)); end; function TIDCGen.OutputRTTIHeader(kind:LKind; _pos:Integer): Integer; @@ -293,6 +340,7 @@ function TIDCGen.OutputRTTIHeader(kind:LKind; _pos:Integer): Integer; adr := Pos2Adr(_pos); s:=Format('MakeUnkn(0x%x, 1);'+#13+'MakeNameEx(0x%x, "RTTI_%x_%s_%s", 0);',[adr,adr,adr,TypeKind2Name(kind),itemName]); idcF.Write(s[1],Length(s)); + Inc(CurrentBytes,Length(s)); //Selfptr _pos := MakeDword(_pos); //Kind @@ -955,6 +1003,7 @@ procedure TIDCGen.OutputRTTIProcedure(kind:LKind; _pos:Integer); adr := pos2Adr(_pos); s:=Format('MakeUnkn(0x%x, 1);'+#13+'MakeNameEx(0x%x, "VMT_%x_%s", 0);'+#13,[adr,adr,adr,vmtName]); idcF.Write(s[1],Length(s)); + Inc(CurrentBytes,Length(s)); //VmtSelfPtr _pos := MakeDword(_pos); Result:= _pos - from; @@ -971,6 +1020,7 @@ procedure TIDCGen.OutputRTTIProcedure(kind:LKind; _pos:Integer); begin s:=Format('MakeUnkn(0x%x, 1);'+#13+'MakeNameEx(0x%x, "%s_IntfTable", 0);'+#13,[intfTable,intfTable,itemName]); idcF.Write(s[1],LEngth(s)); + Inc(CurrentBytes,Length(s)); _pos := Adr2pos(intfTable); //EntryCount Count := PInteger(Code + _pos)^; @@ -1030,6 +1080,7 @@ procedure TIDCGen.OutputRTTIProcedure(kind:LKind; _pos:Integer); begin s:=Format('MakeUnkn(0x%x, 1);'+#13+'MakeNameEx(0x%x, "%s_AutoTable", 0);'+#13,[autoTable,autoTable,itemName]); idcF.Write(s[1],Length(s)); + Inc(CurrentBytes,Length(s)); _pos := Adr2pos(autoTable); //EntryCount Count := PInteger(Code + _pos)^; @@ -1079,6 +1130,7 @@ procedure TIDCGen.OutputRTTIProcedure(kind:LKind; _pos:Integer); begin s:=Format('MakeUnkn(0x%x, 1);'+#13+'MakeNameEx(0x%x, "%s_InitTable", 0);'+#13,[initTable,initTable,itemName]); idcF.Write(s[1],Length(s)); + Inc(CurrentBytes,Length(s)); _pos := Adr2pos(initTable); //0xE _pos := MakeByte(_pos); @@ -1110,6 +1162,7 @@ procedure TIDCGen.OutputRTTIProcedure(kind:LKind; _pos:Integer); begin s:=Format('MakeUnkn(0x%x, 1);'+#13+'MakeNameEx(0x%x, "%s_FieldTable", 0);'+#13,[fieldTable,fieldTable,itemName]); idcF.Write(s[1],Length(s)); + Inc(CurrentBytes,Length(s)); _pos := Adr2pos(fieldTable); //num num := PInteger(Code + _pos)^; @@ -1178,6 +1231,7 @@ procedure TIDCGen.OutputRTTIProcedure(kind:LKind; _pos:Integer); s:=Format('MakeUnkn(0x%lX, 1);'+#13+'MakeNameEx(0x%lX, \"%s_MethodTable\", 0);'+#13, [methodTable,methodTable,itemName]); idcF.Write(s[1],Length(s)); + Inc(CurrentBytes,Length(s)); _pos := Adr2pos(methodTable); //Count count := PWORD(Code + _pos)^; @@ -1291,6 +1345,7 @@ procedure TIDCGen.OutputRTTIProcedure(kind:LKind; _pos:Integer); s:=Format('MakeUnkn(0x%x, 1);'+#13+'MakeNameEx(0x%x, "%s_DynamicTable", 0);'+#13, [dynamicTable,dynamicTable,itemName]); idcF.Write(s[1],Length(s)); + Inc(CurrentBytes,Length(s)); _pos := Adr2pos(dynamicTable); //Num num := PWord(Code + _pos)^; @@ -1335,6 +1390,7 @@ procedure TIDCGen.OutputRTTIProcedure(kind:LKind; _pos:Integer); names.Add(itemName); s:=Format('MakeUnkn(0x%x, 1);'+#13+'MakeNameEx(0x%x, "%s", 0x20);'+#13,[fromAdr,fromAdr,itemName]); idcF.Write(s[1],Length(s)); + Inc(CurrentBytes,Length(s)); end else begin @@ -1351,6 +1407,7 @@ procedure TIDCGen.OutputRTTIProcedure(kind:LKind; _pos:Integer); s:=Format('MakeUnkn(0x%x, 1);'+#13+'MakeNameEx(0x%x, "%s_%d", 0x20);'+#13, [fromAdr,fromAdr,itemName,cnt]); idcF.Write(s[1],Length(s)); + Inc(CurrentBytes,Length(s)); end; MakeComment(_pos, recN.MakePrototype(fromAdr, true, false, false, true, false)); end; @@ -1366,6 +1423,7 @@ procedure TIDCGen.OutputRTTIProcedure(kind:LKind; _pos:Integer); begin s:=Format('MakeFunction(0x%x, 0x%x);'+#13,[fromAdr,fromAdr + instrLen]); idcF.Write(s[1],Length(s)); + Inc(CurrentBytes,Length(s)); Result:= instrLen - 1;//:= procSize - 1 Exit; end; @@ -1375,6 +1433,7 @@ procedure TIDCGen.OutputRTTIProcedure(kind:LKind; _pos:Integer); begin s:=Format('MakeFunction(0x%x, 0x%x);'+#13,[fromAdr, pos2Adr(_pos) + 1]); idcF.Write(s[1],Length(s)); + Inc(CurrentBytes,Length(s)); break; end; recN1 := GetInfoRec(pos2Adr(_pos)); @@ -1432,6 +1491,7 @@ procedure TIDCGen.OutputRTTIProcedure(kind:LKind; _pos:Integer); names.Add(_name); s:=Format('MakeUnkn(0x%x, 1);'+#13+'MakeNameEx(0x%x, "%s", 0);'+#13,[adr,adr,_name]); idcF.Write(s[1],Length(s)); + Inc(CurrentBytes,Length(s)); end else begin @@ -1448,6 +1508,7 @@ procedure TIDCGen.OutputRTTIProcedure(kind:LKind; _pos:Integer); s:=Format('MakeUnkn(0x%x, 1);'+#13+'MakeNameEx(0x%x, "%s_%d", 0);'+#13, [adr,adr,_name,cnt]); idcF.Write(s[1],Length(s)); + Inc(CurrentBytes,Length(s)); end; end; if recN._type <> '' then MakeComment(_pos, recN._type); @@ -1466,5 +1527,20 @@ procedure TIDCGen.OutputRTTIProcedure(kind:LKind; _pos:Integer); Result:=Nil; end; +Constructor TSaveIDCDialog.Create(AOwner:TComponent); +Begin + Inherited; + Options:=Options + [ofEnableSizing]; + if SplitIDC then CheckDlgButton(Handle,chkSplit_ID,BST_CHECKED) + else CheckDlgButton(Handle,chkSplit_ID,BST_UNCHECKED); +end; + +procedure TSaveIDCDialog.WndProc(var Msg:TMessage); +Begin + if (Msg.Msg = WM_COMMAND)and(Msg.WParamLo = chkSplit_ID) then + SplitIDC:=IsDlgButtonChecked(Handle,chkSplit_ID) = BST_CHECKED; + Inherited; +end; + End. diff --git a/IdcSplitSize.dfm b/IdcSplitSize.dfm new file mode 100644 index 0000000..0f3cdfa --- /dev/null +++ b/IdcSplitSize.dfm @@ -0,0 +1,55 @@ +object FIdcSplitSize: TFIdcSplitSize + Left = 455 + Top = 379 + BorderStyle = bsToolWindow + ClientHeight = 108 + ClientWidth = 313 + Color = clBtnFace + ParentFont = True + OldCreateOrder = True + Position = poScreenCenter + OnShow = FormShow + PixelsPerInch = 96 + TextHeight = 13 + object Bevel1: TBevel + Left = 8 + Top = 8 + Width = 297 + Height = 65 + Shape = bsFrame + end + object OKBtn: TButton + Left = 55 + Top = 76 + Width = 75 + Height = 25 + Caption = 'OK' + Default = True + ModalResult = 1 + TabOrder = 0 + OnClick = OKBtnClick + end + object CancelBtn: TButton + Left = 183 + Top = 76 + Width = 75 + Height = 25 + Cancel = True + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 1 + OnClick = CancelBtnClick + end + object tbSplitSize: TTrackBar + Left = 16 + Top = 24 + Width = 281 + Height = 45 + Min = 1 + PageSize = 1 + Position = 1 + TabOrder = 2 + TickMarks = tmTopLeft + OnChange = tbSplitSizeChange + end +end diff --git a/IdcSplitSize.pas b/IdcSplitSize.pas new file mode 100644 index 0000000..9ae645f --- /dev/null +++ b/IdcSplitSize.pas @@ -0,0 +1,57 @@ +unit IdcSplitSize; + +interface + +uses + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, ComCtrls, StdCtrls, ExtCtrls; + +type + TFIdcSplitSize = class(TForm) + OKbtn:TButton; + CancelBtn:TButton; + Bevel1:TBevel; + tbSplitSize:TTrackBar; + Procedure OKBtnClick(Sender:TObject); + procedure CancelBtnClick(Sender:TObject); + procedure FormShow(Sender: TObject); + procedure tbSplitSizeChange(Sender:TObject); + private + { Private declarations } + public + { Public declarations } + end; + +var + FIdcSplitSize: TFIdcSplitSize; + +implementation + +{$R *.dfm} + +uses Main; + +Procedure TFIdcSplitSize.OKBtnClick (Sender:TObject); +Begin + SplitSize := (1 SHL (tbSplitSize.Position + 19)); //MBytes + ModalResult := mrOk; +end; + +Procedure TFIdcSplitSize.CancelBtnClick (Sender:TObject); +Begin + SplitSize:=0; + ModalResult:=mrCancel; +end; + +procedure TFIdcSplitSize.FormShow(Sender: TObject); +begin + Caption:='Split size: 1 Mbyte'; +end; + +Procedure TFIdcSplitSize.tbSplitSizeChange (Sender:TObject); +Begin + Caption:='Split size: '+IntToStr(tbSplitSize.position)+' MByte'; +end; + + +end. diff --git a/Idr.dof b/Idr.dof index 0813c08..1c8fc7c 100644 --- a/Idr.dof +++ b/Idr.dof @@ -113,9 +113,9 @@ RootDir=C:\Program Files (x86)\Borland\Delphi7\Bin\ IncludeVerInfo=1 AutoIncBuild=0 MajorVer=1 -MinorVer=1 +MinorVer=2 Release=0 -Build=1339 +Build=9 Debug=0 PreRelease=0 Special=0 @@ -126,7 +126,7 @@ CodePage=1251 [Version Info Keys] CompanyName= FileDescription= -FileVersion=1.1.0.1339 +FileVersion=1.2.0.9 InternalName= LegalCopyright= LegalTrademarks= diff --git a/Idr.dpr b/Idr.dpr index b909743..6f86e99 100644 --- a/Idr.dpr +++ b/Idr.dpr @@ -36,7 +36,8 @@ uses Infos in 'Infos.pas', Decompiler in 'Decompiler.pas', Resources in 'Resources.pas', - KnowledgeBase in 'KnowledgeBase.pas'; + KnowledgeBase in 'KnowledgeBase.pas', + IdcSplitSize in 'IdcSplitSize.pas'; {$R *.RES} @@ -57,5 +58,6 @@ begin Application.CreateForm(TFHex2DoubleDlg, FHex2DoubleDlg); Application.CreateForm(TFPlugins, FPlugins); Application.CreateForm(TFActiveProcesses, FActiveProcesses); + Application.CreateForm(TFIdcSplitSize, FIdcSplitSize); Application.Run; end. diff --git a/Idr.res b/Idr.res index c83e0dfc1be26ea872acbb6f3cec44a1072b4a10..6fc734488233df081742783ea0023ee6afd22f27 100644 GIT binary patch delta 73 zcmdnuu*PA-3|YpK$uni;f#gnEeLf}zMg~p>1_lT{`J1d9a>|VBCR@s-GaE2) XOkOOf$Z5o&$6x@&mYc82#WMl`y&(~d delta 81 zcmZ4Eu*G4+3|YpS$uni;f#gnEeLhA8Mh0tE1|SKdCx4TbW4tw4R8E<3+hj|*bY?RK e?#YYg6a@_#^cW0)*pR^(2rU^HHlLM?X9NIUt`fHZ diff --git a/Infos.pas b/Infos.pas index 1bb5bd0..f0eac5a 100644 --- a/Infos.pas +++ b/Infos.pas @@ -35,9 +35,11 @@ InfoProcInfo = class Procedure DeleteArg(n:Integer); Procedure DeleteArgs; Function AddLocal(_Ofs, _Size:Integer; _Name, _TypeDef:AnsiString):PLocalInfo; - Function GetLocal(Ofs:Integer):PLocalInfo; + Function GetLocal(Ofs:Integer):PLocalInfo; Overload; + function GetLocal(Const AName:AnsiString): PLocalInfo; overload; Procedure DeleteLocal(n:Integer); Procedure DeleteLocals; + procedure SetLocalType(Offset:Integer;Const TypeDef:AnsiString); End; InfoRec = class @@ -79,7 +81,7 @@ InfoRec = class Implementation -Uses SysUtils,StrUtils,Misc,Main,Def_disasm,Scanf,Dialogs; +Uses Types,SysUtils,StrUtils,Misc,Main,Def_disasm,Scanf,Dialogs; Function FieldsCmpFunction(item1,item2:Pointer):Integer; Begin @@ -367,6 +369,11 @@ InfoRec = class aInfo.Tag:=$22; _Name:=Trim(Copy(t,p+1,Length(t))); end + else if SameText(m,'const') Then + Begin + aInfo.Tag:=$23; + _Name:=Trim(Copy(t,p+1,Length(t))); + end else Begin ShowMessage('Unknown argument modifier '+IntToStr(i+1)); @@ -518,6 +525,19 @@ InfoRec = class Result:=Nil; end; +Function InfoProcInfo.GetLocal(Const AName:AnsiString):PLocalInfo; +var + n:Integer; +Begin + If Assigned(locals) Then + for n:=0 to locals.Count-1 do + Begin + Result:=locals[n]; + if SameText(Result.Name,AName) then Exit; + end; + REsult:=Nil; +end; + Procedure InfoProcInfo.DeleteLocal (n:Integer); Begin if Assigned(locals) and (n >= 0) and (n < locals.Count) then locals.Delete(n); @@ -535,6 +555,94 @@ InfoRec = class end; end; +procedure InfoProcInfo.SetLocalType(Offset:Integer;Const TypeDef:AnsiString); +var + locInfo:PLocalInfo; + fname,recFilename,_name,_type,str:AnsiString; + p:PAnsiChar; + _pos,ofs,size,idx,k:Integer; + len:Word; + recFile:TextFile; + tInfo:MTypeInfo; + _uses:TWordDynArray; +Begin + locInfo:=GetLocal(Offset); + if Assigned(locInfo) then + Begin + fname := locInfo.Name; + _pos := Pos('.',fname); + if _pos<>0 then fname := Copy(fname,1, _pos - 1); + locInfo.TypeDef := TypeDef; + if (TypeDef <>'') And (GetTypeKind(TypeDef, size) = ikRecord) then + begin + recFilename:=FMain.WrkDir + '\types.idr'; + if FileExists(recFileName) then + begin + AssignFile(recFile,recFilename); + Reset(recFile); + try + while not eof(recFile) do + begin + ReadLn(recFile,str); + if Pos(TypeDef + '=',str) = 1 then + while Not eof(recFile) do + begin + ReadLn(recFile,str); + if Pos('end;',str)<>0 Then break; + if Pos('//',str)<>0 then + begin + ofs := StrGetRecordFieldOffset(str); + _name := StrGetRecordFieldName(str); + _type := StrGetRecordFieldType(str); + if ofs >= 0 then AddLocal(ofs + Offset, 1, fname + '.' + _name, _type); + end; + end; + end; + Finally + CloseFile(recFile); + end; + end; + while true do + begin + //KB + _uses := KBase.GetTypeUses(PAnsiChar(TypeDef)); + idx := KBase.GetTypeIdxByModuleIds(_uses, PAnsiChar(TypeDef)); + _uses:=Nil; + if idx = -1 then break; + idx := KBase.TypeOffsets[idx].NamId; + if KBase.GetTypeInfo(idx, [INFO_FIELDS], tInfo) then + begin + if tInfo.FieldsNum<>0 then + begin + p := tInfo.Fields; + for k := 1 to tInfo.FieldsNum do + begin + //Scope + Inc(p); + ofs := PInteger(p)^; + Inc(p, 4); + Inc(p, 4);//case + //Name + len := PWord(p)^; + Inc(p, 2); + _name := MakeString(p, len); + Inc(p, len + 1); + //Type + len := PWord(p)^; + Inc(p, 2); + _type := TrimTypeName(MakeString(p, len)); + Inc(p, len + 1); + AddLocal(Offset + ofs, 1, fname + '.' + _name, _type); + end; + break; + end; + ///if tInfo.Decl <> '' then TypeDef := tInfo.Decl; + end; + end; + end; + end; +end; + Constructor InfoRec.Create (APos:Integer; AKind:LKind); Begin kind:=AKind; @@ -1137,7 +1245,8 @@ procedure InfoRec.Load(ins:TStream; buf:Pointer); else result:=Result + ' '; End; aInfo := PArgInfo(procInfo.args[n]); - if aInfo.Tag = $22 then result:=Result + 'var '; + if aInfo.Tag = $22 then result:=Result + 'var ' + Else if aInfo.Tag = $23 then result:=Result + 'const '; // Add by ZGL if aInfo.Name <> '' then result:=Result + aInfo.Name else result:=Result + '?'; result:=Result + ':'; @@ -1237,7 +1346,8 @@ procedure InfoRec.Load(ins:TStream; buf:Pointer); Begin if n <> firstArg then Result:=Result + '; '; aInfo := PArgInfo(procInfo.args[n]); - if aInfo.Tag = $22 then Result:=Result + 'var '; + if aInfo.Tag = $22 then Result:=Result + 'var ' + Else if aInfo.Tag = $23 then Result:=Result+'const '; // Add by ZGL if aInfo.Name <> '' then Result:=Result + aInfo.Name else Result:=Result + '?'; Result:=Result + ':'; @@ -1319,7 +1429,8 @@ procedure InfoRec.Load(ins:TStream; buf:Pointer); if n <> firstArg then result:=result + ';'+#13; aInfo := PArgInfo(procInfo.args[n]); //var - if aInfo.Tag = $22 then result:=result + 'var '; + if aInfo.Tag = $22 then result:=result + 'var ' + else if aInfo.Tag = $23 then result:=result + 'const '; // Add by ZGL //name if aInfo.Name <> '' then result:=result + aInfo.Name else result:=result + '?'; @@ -1361,7 +1472,7 @@ procedure InfoRec.Load(ins:TStream; buf:Pointer); _type := 'HRESULT'; procInfo.call_kind := 3; //stdcall procInfo.AddArg($21, 8, 4, 'Self', ''); - procInfo.AddArg($21, 12, 4, 'IID', 'TGUID'); + procInfo.AddArg($23, 12, 4, 'IID', 'TGUID'); // Fixed by ZGL procInfo.AddArg($22, 16, 4, 'Obj', 'Pointer'); Exit; End @@ -1434,7 +1545,7 @@ procedure InfoRec.Load(ins:TStream; buf:Pointer); Begin kind := ikProc; procInfo.AddArg($22, 0, 4, 'Dest', sname); - procInfo.AddArg($21, 1, 4, 'Source', sname); + procInfo.AddArg($23, 1, 4, 'Source', sname); // Modified by ZGL Exit; End //@LStrFromPCharLen, @WStrFromPCharLen, @UStrFromPCharLen @@ -1492,7 +1603,7 @@ procedure InfoRec.Load(ins:TStream; buf:Pointer); Begin kind := ikProc; procInfo.AddArg($22, 0, 4, 'Dest', sname); - procInfo.AddArg($21, 1, 4, 'Source', 'ShortString'); + procInfo.AddArg($23, 1, 4, 'Source', 'ShortString'); // Modified by ZGL Exit; End //@LStrFromArray, @WStrFromArray, @UStrFromArray @@ -1518,7 +1629,7 @@ procedure InfoRec.Load(ins:TStream; buf:Pointer); Begin kind := ikProc; procInfo.AddArg($22, 0, 4, 'Dest', sname); - procInfo.AddArg($21, 1, 4, 'Source', 'WideString'); + procInfo.AddArg($23, 1, 4, 'Source', 'WideString'); // Modified by ZGL Exit; End //@LStrToString, @WStrToString, @UStrToString @@ -1526,7 +1637,7 @@ procedure InfoRec.Load(ins:TStream; buf:Pointer); Begin kind := ikProc; procInfo.AddArg($22, 0, 4, 'Dest', 'ShortString'); - procInfo.AddArg($21, 1, 4, 'Source', sname); + procInfo.AddArg($23, 1, 4, 'Source', sname); // Modified by ZGL procInfo.AddArg($21, 2, 4, 'MaxLen', 'Integer'); Exit; End @@ -1592,7 +1703,7 @@ procedure InfoRec.Load(ins:TStream; buf:Pointer); Begin kind := ikFunc; _type := sname; - procInfo.AddArg($21, 0, 4, 'S', sname); + procInfo.AddArg($23, 0, 4, 'S', sname); // Modified by ZGL procInfo.AddArg($21, 1, 4, 'Index', 'Integer'); procInfo.AddArg($21, 2, 4, 'Count', 'Integer'); Exit; @@ -1610,7 +1721,7 @@ procedure InfoRec.Load(ins:TStream; buf:Pointer); else if SameText(tmp, 'StrInsert') then Begin kind := ikProc; - procInfo.AddArg($21, 0, 4, 'Source', sname); + procInfo.AddArg($23, 0, 4, 'Source', sname); // Modified by ZGL procInfo.AddArg($22, 1, 4, 'S', sname); procInfo.AddArg($21, 2, 4, 'Index', 'Integer'); Exit; @@ -1620,8 +1731,8 @@ procedure InfoRec.Load(ins:TStream; buf:Pointer); Begin kind := ikFunc; _type := 'Integer'; - procInfo.AddArg($21, 0, 4, 'Substr', sname); - procInfo.AddArg($21, 1, 4, 'S', sname); + procInfo.AddArg($23, 0, 4, 'Substr', sname); // by ZGL + procInfo.AddArg($23, 1, 4, 'S', sname); // by ZGL Exit; End //@LStrSetLength, @WStrSetLength, @UStrSetLength @@ -1654,7 +1765,7 @@ procedure InfoRec.Load(ins:TStream; buf:Pointer); Begin kind := ikProc; procInfo.AddArg($22, 0, 4, 'Dest', sname); - procInfo.AddArg($21, 1, 4, 'Source', 'AnsiString'); + procInfo.AddArg($23, 1, 4, 'Source', 'AnsiString'); // by ZGL Exit; End //@WStrOfWChar diff --git a/KnowledgeBase.pas b/KnowledgeBase.pas index d933972..26f55b9 100644 --- a/KnowledgeBase.pas +++ b/KnowledgeBase.pas @@ -442,7 +442,7 @@ MKnowledgeBase = class Result := []; if not Inited Or (ItemName=Nil)or(ItemName^=#0) then Exit; if GetIdx(ConstCount,ConstOffsets,ModuleIDs,ItemName,False)<>-1 then Include(Result, KB_CONST_SECTION); - if GetIdx(TypeCount,TypeOffsets,ModuleIDs,ItemName,True)<>-1 then Include(Result, KB_TYPE_SECTION); + if GetIdx(TypeCount,TypeOffsets,ModuleIDs,ItemName,Version>=2{True})<>-1 then Include(Result, KB_TYPE_SECTION); If GetIdx(VarCount,VarOffsets,ModuleIDs,ItemName,False)<>-1 then Include(Result, KB_VAR_SECTION); if GetIdx(ResStrCount,ResStrOffsets,ModuleIDs,ItemName,False)<>-1 then Include(Result, KB_RESSTR_SECTION); if GetIdx(ProcCount,ProcOffsets,ModuleIDs,ItemName,False)<>-1 Then Include(Result, KB_PROC_SECTION); @@ -467,14 +467,14 @@ MKnowledgeBase = class Begin if not Inited or (ModuleIDs=Nil) or (TypeName=Nil) or (TypeName^=#0) or (TypeCount=0) then Result:=-1 - Else Result:=GetIdx(TypeCount,TypeOffsets,ModuleIDs,TypeName,True); + Else Result:=GetIdx(TypeCount,TypeOffsets,ModuleIDs,TypeName,Version>=2{True}); end; Function MKnowledgeBase.GetTypeIdxsByName (TypeName:PAnsiChar; Var TypeIdx:Integer):Integer; Begin TypeIdx := -1; if not Inited or (TypeName=Nil) Or (TypeName^=#0) or (TypeCount=0) then Result:=0 - else Result:=GetIdxName(TypeCount,TypeOffsets,TypeName,TypeIdx,True); + else Result:=GetIdxName(TypeCount,TypeOffsets,TypeName,TypeIdx,Version>=2{True}); end; Function MKnowledgeBase.GetTypeIdxByUID (UID:AnsiString):Integer; @@ -1070,8 +1070,13 @@ MKnowledgeBase = class Result:=False; if not Inited Or (ATypeIdx = -1) then Exit; p := GetKBCachePtr(TypeOffsets[ATypeIdx].Offset, TypeOffsets[ATypeIdx].Size); - tInfo.Size := PInteger(p)^; - Inc(p, 4); + //Modified by ZGL + if Version=1 then tInfo.Size:=TypeOffsets[ATypeIdx].Size + else + begin + tInfo.Size := PInteger(p)^; + Inc(p, 4); + end; tInfo.ModuleID := PWord(p)^; Inc(p, 2); Len := PWord(p)^; @@ -1357,6 +1362,8 @@ MKnowledgeBase = class M := (L + R) div 2; ID := TypeOffsets[M].NamId; p := GetKBCachePtr(TypeOffsets[ID].Offset, TypeOffsets[ID].Size) + 4; + if Version >= 2 then Inc(p, 4); //Add by ZGL + res := stricomp(TypeName, p + 4); if res < 0 then R := M - 1 else if res > 0 then L := M + 1 @@ -1374,6 +1381,7 @@ MKnowledgeBase = class begin ID := TypeOffsets[N].NamId; p := GetKBCachePtr(TypeOffsets[ID].Offset, TypeOffsets[ID].Size) + 4; + if Version >= 2 then Inc(p, 4); //Add by ZGL if stricomp(TypeName, p + 4)<>0 Then Break; ModID := PWord(p)^; if (ModID <> $FFFF) and (Result[num - 1] <> ModID) then @@ -1388,6 +1396,7 @@ MKnowledgeBase = class begin ID := TypeOffsets[N].NamId; p := GetKBCachePtr(TypeOffsets[ID].Offset, TypeOffsets[ID].Size) + 4; + if Version >= 2 then Inc(p, 4); //Add by ZGL if stricomp(TypeName, p + 4)<>0 then Break; ModID := PWord(p)^; if (ModID <> $FFFF) and (Result[num - 1] <> ModID) then diff --git a/Main.dfm b/Main.dfm index f2f8c86..a24bd78 100644 --- a/Main.dfm +++ b/Main.dfm @@ -26,7 +26,7 @@ object FMain: TFMain TextHeight = 13 object SplitterH1: TSplitter Left = 0 - Top = 600 + Top = 598 Width = 1121 Height = 3 Cursor = crVSplit @@ -39,7 +39,7 @@ object FMain: TFMain object SplitterV1: TSplitter Left = 215 Top = 0 - Height = 585 + Height = 583 AutoSnap = False Color = clNavy MinSize = 3 @@ -49,8 +49,8 @@ object FMain: TFMain Left = 218 Top = 0 Width = 903 - Height = 585 - ActivePage = tsCodeView + Height = 583 + ActivePage = tsNames Align = alClient TabOrder = 1 OnChange = pcWorkAreaChange @@ -60,7 +60,7 @@ object FMain: TFMain Left = 0 Top = 25 Width = 785 - Height = 532 + Height = 530 Cursor = crIBeam Style = lbOwnerDrawFixed AutoComplete = False @@ -183,7 +183,7 @@ object FMain: TFMain Left = 785 Top = 25 Width = 110 - Height = 532 + Height = 530 Style = lbOwnerDrawFixed Align = alRight Color = clWhite @@ -209,7 +209,7 @@ object FMain: TFMain Left = 0 Top = 40 Width = 895 - Height = 517 + Height = 515 Align = alClient Color = clWhite Font.Charset = DEFAULT_CHARSET @@ -254,7 +254,7 @@ object FMain: TFMain Left = 0 Top = 40 Width = 895 - Height = 517 + Height = 515 Align = alClient Color = clWhite Font.Charset = DEFAULT_CHARSET @@ -301,7 +301,7 @@ object FMain: TFMain Left = 785 Top = 25 Width = 110 - Height = 532 + Height = 530 Style = lbOwnerDrawFixed Align = alRight Font.Charset = DEFAULT_CHARSET @@ -321,7 +321,7 @@ object FMain: TFMain Left = 0 Top = 25 Width = 785 - Height = 532 + Height = 530 Align = alClient DefaultText = 'Node' Font.Charset = RUSSIAN_CHARSET @@ -426,7 +426,7 @@ object FMain: TFMain Left = 785 Top = 25 Width = 110 - Height = 532 + Height = 530 Style = lbOwnerDrawFixed Align = alRight Font.Charset = DEFAULT_CHARSET @@ -446,7 +446,7 @@ object FMain: TFMain Left = 0 Top = 25 Width = 785 - Height = 532 + Height = 530 Align = alClient DefaultText = 'Node' Font.Charset = RUSSIAN_CHARSET @@ -485,6 +485,7 @@ object FMain: TFMain Margin = 0 ParentFont = False ParentShowHint = False + PopupMenu = pmNames ScrollBarOptions.AlwaysVisible = True ShowHint = True TabOrder = 2 @@ -524,6 +525,7 @@ object FMain: TFMain ParentFont = False PopupMenu = pmSourceCode TabOrder = 0 + OnClick = lbSourceCodeClick OnDrawItem = lbSourceCodeDrawItem OnMouseMove = lbSourceCodeMouseMove end @@ -533,7 +535,7 @@ object FMain: TFMain Left = 0 Top = 0 Width = 215 - Height = 585 + Height = 583 ActivePage = tsUnits Align = alLeft Constraints.MinWidth = 200 @@ -545,7 +547,7 @@ object FMain: TFMain Left = 0 Top = 0 Width = 207 - Height = 557 + Height = 555 Align = alClient DefaultText = 'Node' Font.Charset = RUSSIAN_CHARSET @@ -607,7 +609,7 @@ object FMain: TFMain Left = 0 Top = 0 Width = 207 - Height = 557 + Height = 555 Align = alClient DefaultText = 'Node' Font.Charset = RUSSIAN_CHARSET @@ -668,7 +670,7 @@ object FMain: TFMain ImageIndex = 3 object Splitter1: TSplitter Left = 0 - Top = 383 + Top = 381 Width = 207 Height = 4 Cursor = crVSplit @@ -704,7 +706,7 @@ object FMain: TFMain Left = 0 Top = 40 Width = 207 - Height = 343 + Height = 341 AutoComplete = False Align = alClient Color = clWhite @@ -725,7 +727,7 @@ object FMain: TFMain end object Panel4: TPanel Left = 0 - Top = 387 + Top = 385 Width = 207 Height = 170 Align = alBottom @@ -815,7 +817,7 @@ object FMain: TFMain end object sb: TStatusBar Left = 0 - Top = 763 + Top = 761 Width = 1121 Height = 20 Constraints.MaxHeight = 20 @@ -831,7 +833,7 @@ object FMain: TFMain end object pb: TProgressBar Left = 0 - Top = 585 + Top = 583 Width = 1121 Height = 15 Align = alBottom @@ -841,7 +843,7 @@ object FMain: TFMain end object vtProc: TVirtualStringTree Left = 0 - Top = 603 + Top = 601 Width = 1121 Height = 160 Align = alBottom @@ -1106,8 +1108,7 @@ object FMain: TFMain OnClick = miIDCGeneratorClick end object miLister: TMenuItem - Caption = 'Lister' - OnClick = miListerClick + Action = acDefCol end object miClassTreeBuilder: TMenuItem Caption = 'Class Tree &Builder' @@ -1442,11 +1443,24 @@ object FMain: TFMain Top = 232 end object pmSourceCode: TPopupMenu + OnPopup = pmSourceCodePopup Left = 488 Top = 96 object miCopySource2Clipboard: TMenuItem Caption = 'Copy to Clipboard' OnClick = miCopySource2ClipboardClick end + object miSetLvartype: TMenuItem + Caption = 'Set Lvar type' + OnClick = SetLvartypeClick + end + end + object pmNames: TPopupMenu + Left = 558 + Top = 96 + object miCopytoClipboardNames: TMenuItem + Caption = 'Copy to Clipboard' + OnClick = miCopytoClipboardNamesClick + end end end diff --git a/Main.pas b/Main.pas index c2e4c96..5f768de 100644 --- a/Main.pas +++ b/Main.pas @@ -52,8 +52,8 @@ TFMain=class(TForm) Panel2: TPanel; rgViewFormAs: TRadioGroup; lbForms: TListBox; - sb: TStatusBar; - pb: TProgressBar; + sb:TStatusBar; + pb:TProgressBar; miCollapseAll: TMenuItem; lbCXrefs: TListBox; ShowCXrefs: TPanel; @@ -180,6 +180,9 @@ TFMain=class(TForm) vtName: TVirtualStringTree; vtString: TVirtualStringTree; vtProc: TVirtualStringTree; + pmNames: TPopupMenu; + miSetLvartype: TMenuItem; + miCopytoClipboardNames: TMenuItem; procedure miExitClick(Sender : TObject); procedure miAutodetectVersionClick(Sender : TObject); procedure FormCreate(Sender : TObject); @@ -311,10 +314,14 @@ TFMain=class(TForm) procedure miSwitchSkipFlagClick(Sender : TObject); procedure miSwitchFrameFlagClick(Sender : TObject); procedure cfTry1Click(Sender : TObject); + procedure lbSourceCodeClick(Sender: TObject); + procedure miCopytoClipboardNamesClick(Sender: TObject); procedure miDelphiXE3Click(Sender : TObject); procedure miDelphiXE4Click(Sender : TObject); Procedure miProcessDumperClick(Sender:TObject); procedure miDelphiXE2Click(Sender: TObject); + procedure pmSourceCodePopup(Sender: TObject); + procedure SetLvartypeClick(Sender: TObject); procedure vtProcClick(Sender: TObject); procedure vtNameClick(Sender: TObject); procedure vtNameCompareNodes(Sender: TBaseVirtualTree; Node1, Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer); @@ -363,6 +370,7 @@ TFMain=class(TForm) Procedure LoadDelphiFile1(FileName:AnsiString; version:Integer; loadExp, loadImp:Boolean); Procedure ReadNode(stream:TStream; node:TTreeNode; buf:PAnsiChar); Procedure OpenProject(FileName:AnsiString); + Function ImportsValid(ImpRVA,ImpSize:Integer):Boolean; Function LoadImage(f:TFileStream; loadExp, loadImp:Boolean):Integer; Procedure FindExports; Procedure FindImports; @@ -445,7 +453,7 @@ TFMain=class(TForm) Procedure ClearPassFlags; Function EstimateProcSize(fromAdr:Integer):Integer; function EvaluateInitTable(Data:PAnsiChar; Size, Base:Integer): Integer; - Function GetField(TypeName:AnsiString; Offset:Integer; var vmt:Boolean; var vmtAdr:Integer):FieldInfo; + function GetField(TypeName:AnsiString; Offset:Integer; var vmt:Boolean; var vmtAdr:Integer;Prefix:AnsiString): FieldInfo; Function AddField(ProcAdr:Integer; ProcOfs:Integer; TypeName:AnsiString; Scope:Byte; Offset, _Case:Integer; Name, _Type:AnsiString):FieldInfo; Function GetMethodOfs(rec:InfoRec; procAdr:Integer):Integer; function GetMethodInfo(rec:InfoRec; _name:AnsiString): PMethodRec; overload; @@ -454,7 +462,7 @@ TFMain=class(TForm) Function GetImportRec(adr:Integer):PImportNameRec; procedure StrapProc(_pos, ProcIdx:Integer; ProcInfo:PMProcInfo; useFixups:Boolean; procSize:Integer); Procedure ShowUnits(showUnk:Boolean); - procedure ShowUnitItems(recU:PUnitRec; topIdx, itemIdx:Integer); + procedure ShowUnitItems(recU:PUnitRec; topIdx, itemIdx:Cardinal); Procedure ShowRTTIs; Procedure FillVmtList; Procedure ShowClassViewer(VmtAdr:Integer); @@ -565,6 +573,7 @@ procedure AddClassAdr(Adr:Integer; const AName:AnsiString); FlagList:array of TCflagSet; //flags for used data OwnTypeList:TList; SelectedAsmItem:AnsiString; //Selected item in Asm Listing + SelectedSourceItem:AnsiString; //Selected item in Source Code CrtSection:TCriticalSection; MaxBufLen:Integer; //Максимальная длина буфера (для загрузки) HInstanceVarAdr:Integer; @@ -573,6 +582,8 @@ procedure AddClassAdr(Adr:Integer; const AName:AnsiString); Units:TList; LastResStrNo:Integer; //Last ResourceStringNo ClassTreeDone:Boolean; + SplitIDC:Boolean; + SplitSize:Integer; implementation @@ -582,7 +593,7 @@ implementation StringInfo, Explorer, FindDlg, EditFieldsDlg,Def_res,IniFiles,TypeInfos, InputDlg,Def_thread, EditFunctionDlg,IDCGen,AboutDlg,ShellAPI,Contnrs, KBViewer, Legend,Decompiler, Hex2Double,Clipbrd, Plugins,ActiveProcesses, - Scanf,TypInfo,Math{,CodeSiteLogging}; + Scanf,TypInfo,Math,IdcSplitSize{,CodeSiteLogging}; Var //Dest:TCodeSiteDestination; @@ -781,6 +792,7 @@ procedure TFMain.miExitClick(Sender : TObject); CurProcAdr := 0; CurProcSize := 0; SelectedAsmItem := ''; + SelectedSourceItem:=''; CurUnitAdr := 0; CodeHistoryPtr := -1; CodeHistorySize := 0; //HISTORY_CHUNK_LENGTH; @@ -973,6 +985,9 @@ procedure TFMain.miExitClick(Sender : TObject); if not Assigned(InfoList[i]) then Begin recN := InfoRec.Create(i, ikRefine); + recN.procInfo.procSize:=6; + SetFlag([cfProcStart],i); + SetFlag([cfProcEnd],i+6); if (Pos('@Initialization$',recI.name)<>0) or (Pos('@Finalization$',recI.name)<>0) then recN.Name:=recI.module + '.' + recI.name else @@ -1464,9 +1479,10 @@ procedure TFMain.miExitClick(Sender : TObject); Inc(p); locflags := PInteger(p)^; Inc(p, 4); + If (locflags and 7) =1 then aInfo.Tag := $23; // Add by ZGL aInfo.in_Reg := (locflags and 8)<>0; //Ndx - ndx := PInteger(p)^; + ndx := PInteger(p)^; Inc(p, 4); aInfo.Size := 4; wlen := PWord(p)^; @@ -2104,11 +2120,13 @@ procedure TFMain.miExitClick(Sender : TObject); Result:=2009; Exit; end + { == disabled by Crypto == else if TControlInstSize = $1AC then begin Result:=2010; Exit; end; + } End; End; Inc(n,4); @@ -2419,7 +2437,7 @@ procedure TFMain.miExitClick(Sender : TObject); Begin ShowMessage('Input file imports Delphi system packages (' + rtlFile + ', ' + vclFile + ').' - + '\r\nIn order to figure out the version, please put those packages in the same folder'); + + chr(13) + 'In order to figure out the version, please put those packages in the same folder'); break; End; @@ -2659,8 +2677,18 @@ procedure TFMain.miExitClick(Sender : TObject); end; Function TFMain.GetUnitName(Adr:Integer):AnsiString; +var + n:Integer; + recU:PUnitRec; Begin - Result:= GetUnitName(GetUnit(Adr)); + Result:=''; + recU:=GetUnit(Adr); + if Assigned(recU) then + for n:=0 To recU.names.Count-1 Do + Begin + If Result<>'' then Result:=Result+', '; + Result:=Result+recU.names[n]; + end; end; Procedure TFMain.SetUnitName (recU:PUnitRec; _name:AnsiString); @@ -2806,10 +2834,13 @@ procedure TFMain.miExitClick(Sender : TObject); End; End; //End of procedure - if DisInfo.Ret and ((lastAdr=0) or (curAdr = lastAdr)) then + if DisInfo.Ret {and ((lastAdr=0) or (curAdr = lastAdr)) } then // removed by Crypto Begin - Inc(curAdr, instrLen); - break; + if Not IsFlagSet([cfLoc],_Pos + instrLen) then // added by Crypto + begin + Inc(curAdr, instrLen); + break; + end; End; if op = OP_MOV then lastMovAdr := DisInfo.Offset; @@ -2869,9 +2900,7 @@ procedure TFMain.miExitClick(Sender : TObject); Begin if Adr > lastAdr then lastAdr := Adr; _Pos := Adr2Pos(Adr); - assert(_Pos >= 0); - delta := _Pos - NPos; - if delta >= 0 then // and delta < outRows) + if _Pos >= 0 then // and delta < outRows) Begin if Code[_Pos] = #$E9 then //jmp Handle... Begin @@ -2927,10 +2956,10 @@ procedure TFMain.miExitClick(Sender : TObject); End; End; End; - Inc(curPos, instrLen); - Inc(curAdr, instrLen); - continue; End; + Inc(curPos, instrLen); + Inc(curAdr, instrLen); + continue; End; End; if (b1 = $EB) or //short relative abs jmp or cond jmp @@ -3905,74 +3934,70 @@ procedure TFMain.miExitClick(Sender : TObject); or (Code[NPos] = #$C3) then Begin Adr := DisInfo.Immediate; //Adr:=@1 - if not IsValidCodeAdr(Adr) then + if IsValidCodeAdr(Adr) then begin - Result:= -1; - Exit; - end; - if Adr > lastAdr then lastAdr := Adr; - _Pos := Adr2Pos(Adr); - assert(_Pos >= 0); - delta := _Pos - NPos; - if delta >= 0 then // and delta < outRows) - Begin - if Code[_Pos] = #$E9 then //jmp Handle... + if Adr > lastAdr then lastAdr := Adr; + _Pos := Adr2Pos(Adr); + if _Pos >= 0 then Begin - //Дизассемблируем jmp - instrLen1 := frmDisasm.Disassemble(Code + _Pos, Adr, @DisInfo, Nil); - //if (!instrLen1) return -1; - recN := GetInfoRec(DisInfo.Immediate); - if Assigned(recN) then + if Code[_Pos] = #$E9 then //jmp Handle... Begin - if recN.SameName('@HandleFinally') then - Begin - //jmp HandleFinally - Inc(_Pos, instrLen1); - Inc(Adr, instrLen1); - //jmp @2 - instrLen2 := frmDisasm.Disassemble(Code + _Pos, Adr, @DisInfo, Nil); - Inc(Adr, instrLen2); - if Adr > lastAdr then lastAdr := Adr; - { - //@2 - Adr1 := DisInfo.Immediate - 4; - Adr := PInteger(Code + Adr2Pos(Adr1))^; - if Adr > lastAdr then lastAdr := Adr; - } - End - else if recN.SameName('@HandleAnyException') or recN.SameName('@HandleAutoException') then - Begin - //jmp HandleAnyException - Inc(_Pos, instrLen1); - Inc(Adr, instrLen1); - //call DoneExcept - instrLen2 := frmDisasm.Disassemble(Code + _Pos, Adr, Nil, Nil); - Inc(Adr, instrLen2); - if Adr > lastAdr then lastAdr := Adr; - End - else if recN.SameName('@HandleOnException') then + //Дизассемблируем jmp + instrLen1 := frmDisasm.Disassemble(Code + _Pos, Adr, @DisInfo, Nil); + //if (!instrLen1) return -1; + recN := GetInfoRec(DisInfo.Immediate); + if Assigned(recN) then Begin - //jmp HandleOnException - Inc(_Pos, instrLen1); - Inc(Adr, instrLen1); - //Флажок cfETable, чтобы правильно вывести данные - SetFlag([cfETable], _Pos); - //dd num - num := PInteger(Code + _Pos)^; - Inc(_Pos, 4); - if Adr + 4 + 8 * num > lastAdr then lastAdr := Adr + 4 + 8 * num; - for k := 0 to num-1 do + if recN.SameName('@HandleFinally') then Begin - //dd offset ExceptionInfo - Inc(_Pos, 4); - //dd offset ExceptionProc + //jmp HandleFinally + Inc(_Pos, instrLen1); + Inc(Adr, instrLen1); + //jmp @2 + instrLen2 := frmDisasm.Disassemble(Code + _Pos, Adr, @DisInfo, Nil); + Inc(Adr, instrLen2); + if Adr > lastAdr then lastAdr := Adr; + { + //@2 + Adr1 := DisInfo.Immediate - 4; + Adr := PInteger(Code + Adr2Pos(Adr1))^; + if Adr > lastAdr then lastAdr := Adr; + } + End + else if recN.SameName('@HandleAnyException') or recN.SameName('@HandleAutoException') then + Begin + //jmp HandleAnyException + Inc(_Pos, instrLen1); + Inc(Adr, instrLen1); + //call DoneExcept + instrLen2 := frmDisasm.Disassemble(Code + _Pos, Adr, Nil, Nil); + Inc(Adr, instrLen2); + if Adr > lastAdr then lastAdr := Adr; + End + else if recN.SameName('@HandleOnException') then + Begin + //jmp HandleOnException + Inc(_Pos, instrLen1); + Inc(Adr, instrLen1); + //Флажок cfETable, чтобы правильно вывести данные + SetFlag([cfETable], _Pos); + //dd num + num := PInteger(Code + _Pos)^; Inc(_Pos, 4); + if Adr + 4 + 8 * num > lastAdr then lastAdr := Adr + 4 + 8 * num; + for k := 0 to num-1 do + Begin + //dd offset ExceptionInfo + Inc(_Pos, 4); + //dd offset ExceptionProc + Inc(_Pos, 4); + End; End; End; End; End; - End; - Inc(curPos, instrLen); + end; + Inc(curPos, instrLen); Inc(curAdr, instrLen); continue; End; @@ -4248,7 +4273,7 @@ TInterfaceTable = record End; End; Inc(vpos, 4); - Inc(v, 4); + Inc(v{, 4}); End; End; //iOffset @@ -4951,7 +4976,7 @@ TInterfaceTable = record Result:=Nil; if not IsValidCodeAdr(adr) then Exit; recN := GetInfoRec(adr); - if Assigned(recN) and Assigned(recN.vmtInfo.methods) then + if Assigned(recN) and Assigned(recN.vmtInfo) and Assigned(recN.vmtInfo.methods) then for n := 0 to recN.vmtInfo.methods.Count-1 do begin Result := recN.vmtInfo.methods[n]; @@ -5119,6 +5144,7 @@ procedure TFMain.FormCreate(Sender : TObject); lbForms.Canvas.Font.Assign(lbForms.Font); lbCode.Canvas.Font.Assign(lbCode.Font); vtProc.Canvas.Font.Assign(vtProc.Font); + lbSourceCode.Canvas.Font.Assign(lbSourceCode.Font); lbCXrefs.Canvas.Font.Assign(lbCXrefs.Font); lbCXrefs.Width := lbCXrefs.Canvas.TextWidth('T')*14; @@ -5260,7 +5286,7 @@ procedure TFMain.FormShow(Sender : TObject); Result := code.Name else Begin - fInfo := GetField(code.Name, code.Offset, vmt, vmtAdr); + fInfo := GetField(code.Name, code.Offset, vmt, vmtAdr,''); if Assigned(fInfo) then Begin Result := code.Name + '.'; @@ -5311,7 +5337,7 @@ procedure TFMain.FormShow(Sender : TObject); b1,b2,op, flags:Byte; db:Char; selectByAdr,NameInside:Boolean; - row, wid, maxwid, _pos, idx, ap, selectedRow:Integer; + row, wid, maxwid, _pos, idx, ap:Integer; canva:TCanvas; num, instrLen, instrLen1, instrLen2, procSize:Integer; k,i,outRows,Adr, Adr1, Pos2, lastMovAdr:Integer; @@ -5332,8 +5358,6 @@ procedure TFMain.FormShow(Sender : TObject); fromPos := Adr2Pos(fromAdr); if fromPos < 0 then Exit; - //if (AnalyzeThread) AnalyzeThread.Suspend(); - selectByAdr := IsValidImageAdr(SelectedIdx); //If procedure is the same then move selection and not update Xrefs if fromAdr = CurProcAdr then @@ -5359,7 +5383,6 @@ procedure TFMain.FormShow(Sender : TObject); End else lbCode.ItemIndex := SelectedIdx; pcWorkArea.ActivePage := tsCodeView; - //if (lbCode.CanFocus()) ActiveControl := lbCode; Exit; End; if not Assigned(AnalyzeThread) then //Clear all Items (used in highlighting) @@ -5403,7 +5426,6 @@ procedure TFMain.FormShow(Sender : TObject); procSize := GetProcSize(fromAdr); curPos := fromPos; curAdr := fromAdr; - selectedRow := -1; while row < outRows do Begin @@ -5455,6 +5477,7 @@ procedure TFMain.FormShow(Sender : TObject); b1 := Byte(Code[curPos]); b2 := Byte(Code[curPos + 1]); + If (b1=0) and (b2=0) and (lastAdr=0) then break; instrLen := frmDisasm.Disassemble(Code + curPos, curAdr, @DisInfo, @disLine); if instrLen=0 then Begin @@ -5468,7 +5491,7 @@ procedure TFMain.FormShow(Sender : TObject); op := frmDisasm.GetOp(DisInfo.Mnem); //Calculate ItemIdx (ItemIdx can be distinct with instruction begin!) - if selectByAdr and (curAdr <= SelectedIdx) and (SelectedIdx < curAdr + instrLen) then selectedRow := row; + ////if selectByAdr and (curAdr <= SelectedIdx) and (SelectedIdx < curAdr + instrLen) then selectedRow := row; //Check inside instruction Fixup or ThreadVar NameInside := false; @@ -5658,9 +5681,7 @@ procedure TFMain.FormShow(Sender : TObject); Begin if Adr > lastAdr then lastAdr := Adr; Pos2 := Adr2Pos(Adr); - assert(Pos2 >= 0); - delta := Pos2 - NPos; - if delta >= 0 then // && delta < outRows) + if Pos2 >= 0 then Begin if Code[Pos2] = #$E9 then //jmp Handle... Begin @@ -5672,7 +5693,7 @@ procedure TFMain.FormShow(Sender : TObject); if recN.SameName('@HandleFinally') then Begin //jmp HandleFinally - Inc(Pos2, instrLen1); + Inc(Pos2, instrLen1); Inc(Adr, instrLen1); //jmp @2 instrLen2 := frmDisasm.Disassemble(Code + Pos2, Adr, @DisInfo, Nil); @@ -5717,13 +5738,13 @@ procedure TFMain.FormShow(Sender : TObject); End; End; End; - wid := AddAsmLine(curAdr, line, flags); - Inc(row); - if wid > maxwid then maxwid := wid; - Inc(curPos, instrLen); - Inc(curAdr, instrLen); - continue; End; + wid := AddAsmLine(curAdr, line, flags); + Inc(row); + if wid > maxwid then maxwid := wid; + Inc(curPos, instrLen); + Inc(curAdr, instrLen); + continue; End; End; @@ -5836,20 +5857,34 @@ procedure TFMain.FormShow(Sender : TObject); End; CurProcSize := (curAdr + instrLen) - CurProcAdr; - pcWorkArea.ActivePage := tsCodeView; - lbCode.ScrollWidth := maxwid + 2; - if selectedRow <> -1 then + If selectByAdr Then Begin - lbCode.Selected[selectedRow] := true; - lbCode.ItemIndex := selectedRow; - End; + for i:=0 to lbCode.Items.Count-1 do + Begin + line:=lbCode.Items[i]; + sscanf(@line[2],'%lX',[@Adr]); + If Adr >= SelectedIdx Then + Begin + if Adr = SelectedIdx then lbCode.ItemIndex:=i + else lbCode.ItemIndex:=i-1; + lbCode.Selected[lbCode.ItemIndex] := True; + Break; + end; + end; + end + Else + Begin + if SelectedIdx<>-1 then lbCode.Selected[SelectedIdx] := True; + lbCode.ItemIndex:=SelectedIdx; + end; if topIdx <> -1 then lbCode.TopIndex := topIdx; lbCode.ItemHeight := lbCode.Canvas.TextHeight('T'); + lbCode.ScrollWidth := maxwid + 2; lbCode.Items.EndUpdate; ShowCodeXrefs(CurProcAdr, XrefIdx); - //if (AnalyzeThread) AnalyzeThread.Resume(); + pcWorkArea.ActivePage := tsCodeView; end; Procedure TFMain.AnalyzeMethodTable (pass:Integer; adr:Integer; Var Terminated:Boolean); @@ -6077,7 +6112,7 @@ procedure TFMain.FormShow(Sender : TObject); begin recN1 := GetInfoRec(pAdr); //Look at parent class methods - if Assigned(recN1) and Assigned(recN1.vmtInfo.methods) then + if Assigned(recN1) and Assigned(recN1.vmtInfo) and Assigned(recN1.vmtInfo.methods) then for m := 0 to recN1.vmtInfo.methods.Count-1 do begin recM := recN1.vmtInfo.methods[m]; @@ -6121,11 +6156,11 @@ procedure TFMain.FormShow(Sender : TObject); Result:=0; fromPos := Adr2Pos(fromAdr); if (fromPos < 0) or IsFlagSet([cfPass0,cfEmbedded,cfExport], fromPos) then Exit; - + { == removed by Crypto b1 := Byte(Code[fromPos]); b2 := Byte(Code[fromPos + 1]); if (b1=0) and (b2=0) then Exit; - + } SetFlag([cfProcStart, cfPass0], fromPos); //Don't analyze imports @@ -6378,7 +6413,7 @@ procedure TFMain.FormShow(Sender : TObject); Begin if Line[n] in [' ',',','[','+'] then Begin - sscanf(PAnsiChar(Line)+n+1,'%lX',[@targetAdr]); + sscanf(@Line[n+1],'%lX',[@targetAdr]); break; End; Dec(n); @@ -6390,7 +6425,7 @@ procedure TFMain.FormShow(Sender : TObject); End; End; if IsValidImageAdr(targetAdr) then trgAdr^ := targetAdr; - Result:=DisInfo.MemSize; + Result:=DisInfo.OpSize; end; procedure TFMain.lbCodeDblClick(Sender : TObject); @@ -6541,7 +6576,13 @@ procedure TFMain.lbCodeDblClick(Sender : TObject); Idx:=proc_data.adres; end; ShowUnitItems(GetUnit(targetAdr), 0{lbUnitItems.TopIndex}, Idx); + rec.adr:=CurProcAdr; + rec.itemIdx:=lbCode.ItemIndex; + rec.xrefIdx:=lbCXrefs.ItemIndex; + rec.topIdx:=lbCode.TopIndex; ShowCode(targetAdr, 0, -1, -1); + CodeHistoryPush(@rec); + ProjectModified:=True; End; End; End @@ -8072,7 +8113,7 @@ procedure TFMain.miClassTreeBuilderClick(Sender : TObject); ps := LastDelimiter(',',str); if ps<>0 then Begin - filename := Copy(str,1, ps - 1); + filename := Copy(str,2, ps - 3); // Modified by ZGL version := StrToIntDef(Copy(str,ps + 1, Length(str) - ps),0); End else @@ -8537,12 +8578,43 @@ procedure TFMain.miDelphiXE4Click(Sender : TObject); FreeAndNil(AnalyzeThread); end; +Function TFMain.ImportsValid(ImpRVA,ImpSize:Integer):Boolean; +Var + EntryRVA,EndRVA,NameLength:Integer; + ImportDescriptor:IMAGE_IMPORT_DESCRIPTOR; +Begin + Result:=False; + if (ImpRVA<>0) or (ImpSize<>0) then + begin + EntryRVA := ImpRVA; + EndRVA := ImpRVA + ImpSize; + while true do + begin + MoveMemory(@ImportDescriptor, (Image + Adr2Pos(EntryRVA + ImageBase)), sizeof(IMAGE_IMPORT_DESCRIPTOR)); + + if (ImportDescriptor.OriginalFirstThunk=0) and + (ImportDescriptor.TimeDateStamp=0) and + (ImportDescriptor.ForwarderChain=0) and + (ImportDescriptor.DllNameRVA=0) and + (ImportDescriptor.FirstThunk=0) then break; + + if not IsValidImageAdr(ImportDescriptor.DllNameRVA + ImageBase) then Exit; + NameLength := strlen(Image + Adr2Pos(ImportDescriptor.DllNameRVA + ImageBase)); + if (NameLength < 0) or (NameLength > 256) then Exit; + if not IsValidModuleName(NameLength, Adr2Pos(ImportDescriptor.DllNameRVA + ImageBase)) Then Exit; + Inc(EntryRVA, sizeof(IMAGE_IMPORT_DESCRIPTOR)); + if EntryRVA >= EndRVA then break; + end; + end; + Result:=true; +end; + Function TFMain.LoadImage (f:TFileStream; loadExp, loadImp:Boolean):Integer; var i, n, m, bytes, ps, SectionsNum, ExpNum, NameLength:Integer; num,DataEnd, Items,rsrcVA,relocVA,evalInitTable,evalEP:Integer; ExpRVA,dp,ExpFuncNamPos,ExpFuncAdrPos,ExpFuncOrdPos:Integer; - EntryRVA,ImpRVA,ImpSize,ThunkRVA,LookupRVA,ThunkValue:Integer; + EntryRVA,EndRVA,ImpRVA,ImpSize,ThunkRVA,LookupRVA,ThunkValue:Integer; msg,moduleName, modName, sEP,impFuncName:AnsiString; dw,Hints:Word; p,sp:PAnsiChar; @@ -8577,7 +8649,7 @@ procedure TFMain.miDelphiXE4Click(Sender : TObject); if (NTHeaders.FileHeader.SizeOfOptionalHeader < sizeof(IMAGE_OPTIONAL_HEADER)) or (NTHeaders.OptionalHeader.Magic <> IMAGE_NT_OPTIONAL_HDR32_MAGIC) then Begin - ShowMessage('File is invalid PE-executable'); + ShowMessage('File is invalid 32-bit PE-executable'); Exit; End; //IDD_ERR_INVALID_PE_EXECUTABLE @@ -8675,6 +8747,14 @@ procedure TFMain.miDelphiXE4Click(Sender : TObject); Cardinal(CodeBase) := Cardinal(ImageBase) + SectionHeaders[0].VirtualAddress; evalInitTable := EvaluateInitTable(Image, TotalSize, Integer(CodeBase)); + if evalInitTable=0 Then + Begin + ShowMessage('Cannot find initialization table'); + SectionHeaders:=Nil; + FreeMem(Image); + Image := Nil; + Exit; + end; evalEP := 0; //Find instruction mov eax,offset InitTable for n := 0 to TotalSize - 6 do @@ -8685,7 +8765,7 @@ procedure TFMain.miDelphiXE4Click(Sender : TObject); End; //Scan up until bytes 0x55 (push ebp) and 0x8B,0xEC (mov ebp,esp) if evalEP<>0 then - while evalEP >= 0 do + while evalEP <> 0 do Begin if (Image[evalEP] = #$55) and (Image[evalEP + 1] = #$8B) and (Image[evalEP + 2] = #$EC) then break; Dec(evalEP); @@ -8785,31 +8865,30 @@ procedure TFMain.miDelphiXE4Click(Sender : TObject); ExpFuncList.Sort(ExportsCmpFunction); End; End; - if loadImp then + ImpRVA:=NTHeaders.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].VirtualAddress; + ImpSize:=NTHeaders.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].Size; + if loadImp and ((ImpRVA<>0)or(ImpSize<>0)) then Begin - //Load Imports - EntryRVA := 0; //next import decriptor RVA - ImpRVA := 0; //import directory RVA - ImpSize := 0; //import directory size - ThunkRVA := 0; //RVA очередного thunk'a (через FirstThunk) - LookupRVA := 0; //RVA очередного thunk'a (через OriginalFirstTunk или FirstThunk) - ThunkValue := 0; //значение очередного thunk'a (через OriginalFirstTunk или FirstThunk) - - Hints := 0; //Ординал или хинт импортируемого символа + if Not ImportsValid(ImpRVA,ImpSize) Then ShowMessage('Imports not valid, will skip!') + else + begin + //Load Imports + EntryRVA := 0; //next import decriptor RVA + EndRVA:=0; //end of imports + ThunkRVA := 0; //RVA of next THUNK (from FirstThunk) + LookupRVA := 0; //RVA of next THUNK (from OriginalFirstTunk or FirstThunk) + ThunkValue := 0; //value of next THUNK (from OriginalFirstTunk or FirstThunk) + Hints := 0; //Ordinal or hint of imported symbol - //DWORD fnProc := 0; - ImpRVA := NTHeaders.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].VirtualAddress; - ImpSize := NTHeaders.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].Size; + //DWORD fnProc = 0; - if (ImpRVA<>0) or (ImpSize<>0) then - Begin - // На первый import descriptor + // First import descriptor EntryRVA := ImpRVA; + EndRVA:=ImpRVA + ImpSize; while true do Begin MoveMemory(@ImportDescriptor, Image + Adr2Pos(EntryRVA + ImageBase), sizeof(IMAGE_IMPORT_DESCRIPTOR)); - // Если все поля дескриптора нулевые, значит список кончился - // Выходим из цикла + //All descriptor fields are NULL - end of list, break if (ImportDescriptor.OriginalFirstThunk=0) and (ImportDescriptor.TimeDateStamp=0) and (ImportDescriptor.ForwarderChain=0) and @@ -8829,20 +8908,18 @@ procedure TFMain.miDelphiXE4Click(Sender : TObject); //HINSTANCE hLib := LoadLibraryEx(moduleName.c_str(), 0, LOAD_LIBRARY_AS_DATAFILE); - // Определяем, откуда будем брать имена импортов: - // из OriginalFirstThunk или FirstThunk + //Define the source of import names (OriginalFirstThunk or FirstThunk) if ImportDescriptor.OriginalFirstThunk<>0 then LookupRVA := ImportDescriptor.OriginalFirstThunk else LookupRVA := ImportDescriptor.FirstThunk; - // Thunk'и с адресами берем всегда из FirstThunk + // ThunkRVA is always get from FirstThunk ThunkRVA := ImportDescriptor.FirstThunk; //Get Imported Functions while true do Begin - // Имена или ординалы берем из LookupTable (которая может быть - // как в OriginalFirstThunk, так и в FirstThunk) + //Names or ordinals we get from LookupTable (this table can be either inside OriginalFirstThunk or FirstThunk) ThunkValue := PInteger(Image + Adr2Pos(LookupRVA + ImageBase))^; if ThunkValue=0 then break; @@ -8855,7 +8932,7 @@ procedure TFMain.miDelphiXE4Click(Sender : TObject); //if (hLib) fnProc := (DWORD)GetProcAddress(hLib, (char*)Hint); - // Но адреса используем только из FirstThunk + // But we use addresses only from FirstThunk //recI.name := modName + '.' + String(Hint); recI.name := IntToStr(Hints); End @@ -8886,6 +8963,7 @@ procedure TFMain.miDelphiXE4Click(Sender : TObject); Inc(LookupRVA, 4); End; Inc(EntryRVA, sizeof(IMAGE_IMPORT_DESCRIPTOR)); + if EntryRVA >= EndRVA then break; //if (hLib) //Begin @@ -8988,7 +9066,7 @@ procedure TFMain.miOpenProjectClick(Sender : TObject); Screen.Cursor := crHourGlass; projectFile := FileOpen(FileName, fmOpenRead or fmShareDenyNone); - //Читаем версию Дельфи и максимальную длину буфера + //Read Delphi version and maximum length of buffer FileSeek(projectFile, 12, Ord(soBeginning)); FileRead(projectFile,_ver, sizeof(_ver)); @@ -9030,7 +9108,7 @@ procedure TFMain.miOpenProjectClick(Sender : TObject); SetVmtConsts(DelphiVersion); - //На время загрузки проекта отключаем пункты меню + //Disable menu items during project loading miLoadFile.Enabled := false; miOpenProject.Enabled := false; miMRF.Enabled := false; @@ -10328,26 +10406,42 @@ procedure TFMain.miIDCGeneratorClick(Sender : TObject); const tmp = 'End;'; var - idcName:AnsiString; + idcName,idcTemplate,s:AnsiString; fIdc:TFileStream; idcGen:TIDCGen; ps:Integer; recN:InfoRec; recU:PUnitRec; kind:LKind; + SaveIDCDialog:TSaveIDCDialog; begin idcName:=''; - if SourceFile <> '' then idcName := ChangeFileExt(SourceFile, '.idc'); - if IDPFile <> '' then idcName := ChangeFileExt(IDPFile, '.idc'); - - SaveDlg.InitialDir := WrkDir; - SaveDlg.Filter := 'IDC|*.idc'; - SaveDlg.FileName := idcName; - if not SaveDlg.Execute then Exit; + if SourceFile <> '' then + Begin + idcName := ChangeFileExt(SourceFile, '.idc'); + idcTemplate:=ChangeFileExt(SourceFile, ''); + end; + if IDPFile <> '' then + Begin + idcName := ChangeFileExt(IDPFile, '.idc'); + idcTemplate:=ChangeFileExt(IDPFile, ''); + End; - idcName := SaveDlg.FileName; + SaveIDCDialog:=TSaveIDCDialog.Create(Self); + SaveIDCDialog.InitialDir := WrkDir; + SaveIDCDialog.Filter := 'IDC|*.idc'; + SaveIDCDialog.FileName := idcName; + if not SaveIDCDialog.Execute then + Begin + SaveIDCDialog.Free; + Exit; + end; + idcName := SaveIDCDialog.FileName; + SaveIDCDialog.Free; if FileExists(idcName) then if Application.MessageBox('File already exists. Overwrite?', 'Warning', MB_YESNO) = IDNO then Exit; + if SplitIDC then + if FIdcSplitSize.ShowModal = mrCancel then Exit; Screen.Cursor := crHourGlass; fIdc:=Nil; @@ -10355,8 +10449,8 @@ procedure TFMain.miIDCGeneratorClick(Sender : TObject); try fIdc := TFileStream.Create(idcName, fmCreate or fmShareDenyWrite); fIdc.Seek(0, soFromEnd); - idcGen := TIDCGen.Create(fIdc); - idcGen.OutputHeader; + idcGen := TIDCGen.Create(fIdc,SplitSize); + idcGen.OutputHeaderFull; ps := 0; while ps < TotalSize do @@ -10367,6 +10461,17 @@ procedure TFMain.miIDCGeneratorClick(Sender : TObject); Inc(ps); continue; end; + if SplitIDC and (idcGen.CurrentBytes >= SplitSize) then + begin + s:='}'; + fIdc.Write(s, 1); + fIdc.Free; + idcName := idcTemplate + '_' + IntToStr(idcGen.CurrentPartNo) + '.idc'; + fIdc := TFileStream.Create(idcName, fmCreate or fmShareDenyWrite); + idcGen.NewIDCPart(fIdc); + idcGen.OutputHeaderShort; + end; + kind := recN.kind; if IsFlagSet([cfRTTI], ps) then Begin @@ -10667,7 +10772,7 @@ procedure TFMain.lbCodeDrawItem(Control: TWinControl; Index:Integer; Rect:TRect; End else if disInfo.OpType[n] = otMEM then Begin - if disInfo.MemSize<>0 then + if disInfo.OpSize<>0 then Begin item := disInfo.sSize + ' ptr '; DrawOneItem(item, canva, Rect, TColor(0), flag); @@ -11179,10 +11284,8 @@ procedure TFMain.OutputCode(Var outF:TextFile; fromAdr:Integer; prototype:AnsiSt if IsValidCodeAdr(Adr) then Begin if Adr > lastAdr then lastAdr := Adr; - Ps := Adr2Pos(Adr); - assert(Ps >= 0); - delta := Ps - NPos; - if delta >= 0 then // and delta < outRows) + Ps := Adr2Pos(Adr); + if Ps >= 0 then Begin if Code[Ps] = #$E9 then //jmp Handle... Begin @@ -11239,12 +11342,12 @@ procedure TFMain.OutputCode(Var outF:TextFile; fromAdr:Integer; prototype:AnsiSt End; End; End; - OutputLine(outF, flags, curAdr, line); - Inc(row); - Inc(curPos, instrLen); - Inc(curAdr, instrLen); - continue; End; + OutputLine(outF, flags, curAdr, line); + Inc(row); + Inc(curPos, instrLen); + Inc(curAdr, instrLen); + continue; End; End; @@ -11377,10 +11480,9 @@ procedure TFMain.OutputCode(Var outF:TextFile; fromAdr:Integer; prototype:AnsiSt SameText(ext, '.dll') or SameText(ext, '.scr')) and miLoadFile.Enabled then DoOpenDelphiFile(DELHPI_VERSION_AUTO, droppedFile, true, true); - //обработали 1й - и валим - пока не умеем > 1 файла одновременно + //We still can not process more than 1 file - quit after the first file break; end; - //TPoint ptDrop = fc->DropPoint; Except end; Finally @@ -11558,7 +11660,7 @@ procedure TFMain.miRenameUnitClick(Sender : TObject); end; end; -Procedure TFMain.ShowUnitItems (recU:PUnitRec; topIdx, itemIdx:Integer); +Procedure TFMain.ShowUnitItems (recU:PUnitRec; topIdx, itemIdx:Cardinal); var unk, imp, exp, emb, xref:Boolean; m,unknum, ps,adr,beg_adr:Integer; @@ -11571,7 +11673,7 @@ procedure TFMain.miRenameUnitClick(Sender : TObject); node:PVirtualNode; proc_data:PProcNode; - procedure retain_focus(a:Integer); + procedure retain_focus(a:Cardinal); Begin if ((itemIdx<$10000)and(node.Index=itemIdx))or((itemIdx>$FFFF)and(a=itemIdx)) then Begin @@ -11682,11 +11784,13 @@ procedure TFMain.miRenameUnitClick(Sender : TObject); end; kind := recN.kind; //Skip calls, that are in the body of some asm-procs (for example, FloatToText from SysUtils) + { if (kind in [ikRefine..ikFunc]) and Assigned(recN.procInfo) and IsFlagSet([cfImport],ps) then begin Inc(adr); continue; end; + } imp := IsFlagSet([cfImport], ps); exp := IsFlagSet([cfExport], ps); emb := false; @@ -12477,11 +12581,11 @@ procedure TFMain.lbXrefsDrawItem(Control: TWinControl; Index:Integer; Rect:TRect lastAdr := 0; fromPos := Adr2Pos(fromAdr); if (fromPos < 0) or IsFlagSet([cfEmbedded], fromPos) then Exit; - + { == Crypto removed this check == b1 := Byte(Code[fromPos]); b2 := Byte(Code[fromPos + 1]); if (b1=0) and (b2=0) then Exit; - + } recN := GetInfoRec(fromAdr); //Virtual constructor - don't analyze @@ -12581,9 +12685,9 @@ procedure TFMain.lbXrefsDrawItem(Control: TWinControl; Index:Integer; Rect:TRect if skipNum > 0 then Begin Adr := finallyAdr; //Adr:=@1 + Pos0 := Adr2Pos(Adr); + if Pos0 < 0 then Break; if Adr > lastAdr then lastAdr := Adr; - Pos0 := Adr2Pos(Adr); - assert(Pos0 >= 0); SetFlag([cfTry], curPos); SetFlags([cfSkip], curPos, skipNum); @@ -12971,128 +13075,129 @@ procedure TFMain.lbXrefsDrawItem(Control: TWinControl; Index:Integer; Rect:TRect or (Code[NPos] = #$C3) then Begin Adr := DisInfo.Immediate; //Adr:=@1 - if Adr > lastAdr then lastAdr := Adr; - Pos0 := Adr2Pos(Adr); - assert(Pos0 >= 0); - delta := Pos0 - NPos; - if (delta>=0) and (delta < MAX_DISASSEMBLE) then - Begin - if Code[Pos0] = #$E9 then //jmp Handle... + if IsValidCodeAdr(Adr) then + begin + if Adr > lastAdr then lastAdr := Adr; + Pos0 := Adr2Pos(Adr); + if (Pos0>=0) and (Pos0 - NPos < MAX_DISASSEMBLE) then Begin - if Code[NPos + 2] = #$35 then + if Code[Pos0] = #$E9 then //jmp Handle... Begin - SetFlag([cfTry], NPos - 6); - SetFlags([cfSkip], NPos - 6, 20); - End - else - Begin - SetFlag([cfTry], NPos - 8); - SetFlags([cfSkip], NPos - 8, 14); - End; - //Disassemble jmp - instrLen1 := frmDisasm.Disassemble(Code + Pos0, Adr, @DisInfo, Nil); - recN1 := GetInfoRec(DisInfo.Immediate); - if Assigned(recN1) and recN1.HasName then - Begin - //jmp @HandleFinally - if recN1.SameName('@HandleFinally') then + if Code[NPos + 2] = #$35 then Begin - SetFlag([cfFinally], Pos0); - SetFlags([cfSkip], Pos0 - 1, instrLen1 + 1); //ret + jmp HandleFinally - Inc(Pos0, instrLen1); - Inc(Adr, instrLen1); - //jmp @2 - instrLen2 := frmDisasm.Disassemble(Code + Pos0, Adr, @DisInfo, Nil); - SetFlag([cfFinally], Pos0); - SetFlags([cfSkip], Pos0, instrLen2); - Inc(Adr, instrLen2); - if Adr > lastAdr then lastAdr := Adr; - //int hfEndPos := Adr2Pos(Adr); - hfStartPos := Adr2Pos(DisInfo.Immediate); - assert(hfStartPos >= 0); - Pos0 := hfStartPos - 5; - - if Code[Pos0] = #$68 then //push offset @3 //Flags[Pos] & cfInstruction must be <> 0 - Begin - hfStartPos := Pos0 - 8; - SetFlags([cfSkip], hfStartPos, 13); - End; - SetFlag([cfFinally], hfStartPos); + SetFlag([cfTry], NPos - 6); + SetFlags([cfSkip], NPos - 6, 20); End - else if recN1.SameName('@HandleAnyException') or recN1.SameName('@HandleAutoException') then + else Begin - SetFlag([cfExcept], Pos0); - hoStartPos := Pos0 - 10; - SetFlags([cfSkip], hoStartPos, instrLen1 + 10); - frmDisasm.Disassemble(Code + Pos0 - 10, Adr - 10, @DisInfo, Nil); - if (frmDisasm.GetOp(DisInfo.Mnem) <> OP_XOR) or (DisInfo.OpRegIdx[0] <> DisInfo.OpRegIdx[1]) then - Begin - hoStartPos := Pos0 - 13; - SetFlags([cfSkip], hoStartPos, instrLen1 + 13); - End; - //Find prev jmp - Pos1 := hoStartPos; - Adr1 := Pos2Adr(Pos1); - for k := 0 to 5 do - Begin - instrLen2 := frmDisasm.Disassemble(Code + Pos1, Adr1, @DisInfo, Nil); - Inc(Pos1, instrLen2); - Inc(Adr1, instrLen2); - End; - if DisInfo.Immediate > lastAdr then lastAdr := DisInfo.Immediate; - //int hoEndPos := Adr2Pos(DisInfo.Immediate); - SetFlag([cfExcept], hoStartPos); - End - else if recN1.SameName('@HandleOnException') then + SetFlag([cfTry], NPos - 8); + SetFlags([cfSkip], NPos - 8, 14); + End; + //Disassemble jmp + instrLen1 := frmDisasm.Disassemble(Code + Pos0, Adr, @DisInfo, Nil); + recN1 := GetInfoRec(DisInfo.Immediate); + if Assigned(recN1) and recN1.HasName then Begin - SetFlag([cfExcept], Pos0); - hoStartPos := Pos0 - 10; - SetFlags([cfSkip], hoStartPos, instrLen1 + 10); - frmDisasm.Disassemble(Code + Pos0 - 10, Adr - 10, @DisInfo, Nil); - if (frmDisasm.GetOp(DisInfo.Mnem) <> OP_XOR) or (DisInfo.OpRegIdx[0] <> DisInfo.OpRegIdx[1]) then + //jmp @HandleFinally + if recN1.SameName('@HandleFinally') then Begin - hoStartPos := Pos0 - 13; - SetFlags([cfSkip], hoStartPos, instrLen1 + 13); - End; - //Find prev jmp - Pos1 := hoStartPos; - Adr1 := Pos2Adr(Pos1); - for k := 0 to 5 do + SetFlag([cfFinally], Pos0); + SetFlags([cfSkip], Pos0 - 1, instrLen1 + 1); //ret + jmp HandleFinally + Inc(Pos0, instrLen1); + Inc(Adr, instrLen1); + //jmp @2 + instrLen2 := frmDisasm.Disassemble(Code + Pos0, Adr, @DisInfo, Nil); + SetFlag([cfFinally], Pos0); + SetFlags([cfSkip], Pos0, instrLen2); + Inc(Adr, instrLen2); + if Adr > lastAdr then lastAdr := Adr; + //int hfEndPos := Adr2Pos(Adr); + hfStartPos := Adr2Pos(DisInfo.Immediate); + assert(hfStartPos >= 0); + Pos0 := hfStartPos - 5; + + if Code[Pos0] = #$68 then //push offset @3 //Flags[Pos] & cfInstruction must be <> 0 + Begin + hfStartPos := Pos0 - 8; + SetFlags([cfSkip], hfStartPos, 13); + End; + SetFlag([cfFinally], hfStartPos); + End + else if recN1.SameName('@HandleAnyException') or recN1.SameName('@HandleAutoException') then Begin - instrLen2 := frmDisasm.Disassemble(Code + Pos1, Adr1, @DisInfo, Nil); - Inc(Pos1, instrLen2); - Inc(Adr1, instrLen2); - End; - if DisInfo.Immediate > lastAdr then lastAdr := DisInfo.Immediate; - //int hoEndPos := Adr2Pos(DisInfo.Immediate); - SetFlag([cfExcept], hoStartPos); - - //Next instruction - Inc(Pos0, instrLen1); - Inc(Adr , instrLen1); - //Set flag cfETable - SetFlag([cfETable], Pos0); - //dd num - num := PInteger(Code + Pos0)^; - SetFlags([cfSkip], Pos0, 4); - Inc(Pos0, 4); - if Adr + 4 + 8 * num > lastAdr then lastAdr := Adr + 4 + 8 * num; - for k := 0 to num-1 do + SetFlag([cfExcept], Pos0); + hoStartPos := Pos0 - 10; + SetFlags([cfSkip], hoStartPos, instrLen1 + 10); + frmDisasm.Disassemble(Code + Pos0 - 10, Adr - 10, @DisInfo, Nil); + if (frmDisasm.GetOp(DisInfo.Mnem) <> OP_XOR) or (DisInfo.OpRegIdx[0] <> DisInfo.OpRegIdx[1]) then + Begin + hoStartPos := Pos0 - 13; + SetFlags([cfSkip], hoStartPos, instrLen1 + 13); + End; + //Find prev jmp + Pos1 := hoStartPos; + Adr1 := Pos2Adr(Pos1); + for k := 0 to 5 do + Begin + instrLen2 := frmDisasm.Disassemble(Code + Pos1, Adr1, @DisInfo, Nil); + Inc(Pos1, instrLen2); + Inc(Adr1, instrLen2); + End; + if DisInfo.Immediate > lastAdr then lastAdr := DisInfo.Immediate; + //int hoEndPos := Adr2Pos(DisInfo.Immediate); + SetFlag([cfExcept], hoStartPos); + End + else if recN1.SameName('@HandleOnException') then Begin - //dd offset ExceptionInfo - SetFlags([cfSkip], Pos0, 4); - Inc(Pos0, 4); - //dd offset ExceptionProc - procAdr := PInteger(Code + Pos0)^; - if IsValidCodeAdr(procAdr) then SetFlag([cfLoc], Adr2Pos(procAdr)); + SetFlag([cfExcept], Pos0); + hoStartPos := Pos0 - 10; + SetFlags([cfSkip], hoStartPos, instrLen1 + 10); + frmDisasm.Disassemble(Code + Pos0 - 10, Adr - 10, @DisInfo, Nil); + if (frmDisasm.GetOp(DisInfo.Mnem) <> OP_XOR) or (DisInfo.OpRegIdx[0] <> DisInfo.OpRegIdx[1]) then + Begin + hoStartPos := Pos0 - 13; + SetFlags([cfSkip], hoStartPos, instrLen1 + 13); + End; + //Find prev jmp + Pos1 := hoStartPos; + Adr1 := Pos2Adr(Pos1); + for k := 0 to 5 do + Begin + instrLen2 := frmDisasm.Disassemble(Code + Pos1, Adr1, @DisInfo, Nil); + Inc(Pos1, instrLen2); + Inc(Adr1, instrLen2); + End; + if DisInfo.Immediate > lastAdr then lastAdr := DisInfo.Immediate; + //int hoEndPos := Adr2Pos(DisInfo.Immediate); + SetFlag([cfExcept], hoStartPos); + + //Next instruction + Inc(Pos0, instrLen1); + Inc(Adr , instrLen1); + //Set flag cfETable + SetFlag([cfETable], Pos0); + //dd num + num := PInteger(Code + Pos0)^; SetFlags([cfSkip], Pos0, 4); Inc(Pos0, 4); + if Adr + 4 + 8 * num > lastAdr then lastAdr := Adr + 4 + 8 * num; + for k := 0 to num-1 do + Begin + //dd offset ExceptionInfo + SetFlags([cfSkip], Pos0, 4); + Inc(Pos0, 4); + //dd offset ExceptionProc + procAdr := PInteger(Code + Pos0)^; + if IsValidCodeAdr(procAdr) then SetFlag([cfLoc], Adr2Pos(procAdr)); + SetFlags([cfSkip], Pos0, 4); + Inc(Pos0, 4); + End; End; End; End; End; - End; - Inc(curPos, instrLen); + end; + Inc(curPos, instrLen); Inc(curAdr, instrLen); continue; End; @@ -13270,7 +13375,7 @@ procedure TFMain.lbXrefsDrawItem(Control: TWinControl; Index:Integer; Rect:TRect b:TCflagSet; n, num, instrLen, instrLen1, instrLen2, _ap, _procSize,aofs:Integer; CNum,NPos,delta,dd,retBytes,dynAdr,cnt,arrAdr,reg1Idx, reg2Idx:Integer; - sp, fromIdx:Integer; //fromIdx - индекс регистра в инструкции mov eax,reg (для обработки вызова @IsClass) + sp, fromIdx:Integer; //fromIdx - index of register in instruction mov eax,reg (for processing call @IsClass) fromPos, curPos, Ps, curAdr, lastMovAdr, procAdr, Val, Adr, Adr1,callOfs:Integer; cTblAdr,jTblAdr,k,reg, varAdr, classAdr, vmtAdr, lastAdr,aa,mm:Integer; recN, recN1:InfoRec; @@ -13301,11 +13406,11 @@ procedure TFMain.lbXrefsDrawItem(Control: TWinControl; Index:Integer; Rect:TRect Result:=False; if (fromPos < 0) or IsFlagSet([cfPass2,cfEmbedded, cfExport], fromPos) then Exit; - + { == Crypto removed this check == b1 := Byte(Code[fromPos]); b2 := Byte(Code[fromPos + 1]); if (b1=0) and (b2=0) then Exit; - + } //Import - return ret type of function if IsFlagSet([cfImport], fromPos) then Exit; recN := GetInfoRec(fromAdr); @@ -13367,16 +13472,15 @@ procedure TFMain.lbXrefsDrawItem(Control: TWinControl; Index:Integer; Rect:TRect End else break; End - else if clsName <> '' then - registers[16]._type := clsName; + else if clsName <> '' then registers[16]._type := clsName; _procSize := GetProcSize(fromAdr); - curPos := fromPos; + curPos := fromPos; curAdr := fromAdr; while true do Begin if curAdr >= Integer(CodeBase) + TotalSize then break; - + //Skip exception table if IsFlagSet([cfETable], curPos) then Begin @@ -13388,6 +13492,7 @@ procedure TFMain.lbXrefsDrawItem(Control: TWinControl; Index:Integer; Rect:TRect End; b1 := Byte(Code[curPos]); b2 := Byte(Code[curPos + 1]); + if (b1=0) and (b2=0) and (lastAdr=0) Then break; instrLen := frmDisasm.Disassemble(Code + curPos, curAdr, @DisInfo, Nil); //if (!instrLen) break; if instrLen=0 then @@ -13577,82 +13682,83 @@ procedure TFMain.lbXrefsDrawItem(Control: TWinControl; Index:Integer; Rect:TRect ) or (Code[NPos] = #$C3) then Begin Adr := DisInfo.Immediate; //Adr:=@1 - if Adr > lastAdr then lastAdr := Adr; - Ps := Adr2Pos(Adr); - assert(Ps >= 0); - delta := Ps - NPos; - if (delta >= 0) and (delta < MAX_DISASSEMBLE) then - Begin - if Code[Ps] = #$E9 then //jmp Handle... + if IsValidCodeAdr(Adr) Then + begin + if Adr > lastAdr then lastAdr := Adr; + Ps := Adr2Pos(Adr); + if (Ps >= 0) and (Ps - NPos < MAX_DISASSEMBLE) then Begin - //Disassemble jmp - instrLen1 := frmDisasm.Disassemble(Code + Ps, Adr, @DisInfo, Nil); - recN := GetInfoRec(DisInfo.Immediate); - if Assigned(recN) then + if Code[Ps] = #$E9 then //jmp Handle... Begin - if recN.SameName('@HandleFinally') then - Begin - //jmp HandleFinally - Inc(Ps, instrLen1); - Inc(Adr, instrLen1); - //jmp @2 - instrLen2 := frmDisasm.Disassemble(Code + Ps, Adr, @DisInfo, Nil); - Inc(Adr, instrLen2); - if Adr > lastAdr then lastAdr := Adr; - End - else if recN.SameName('@HandleAnyException') or recN.SameName('@HandleAutoException') then - Begin - //jmp HandleAnyException - Inc(Ps, instrLen1); - Inc(Adr, instrLen1); - //call DoneExcept - instrLen2 := frmDisasm.Disassemble(Code + Ps, Adr, Nil, Nil); - Inc(Adr, instrLen2); - if Adr > lastAdr then lastAdr := Adr; - End - else if recN.SameName('@HandleOnException') then + //Disassemble jmp + instrLen1 := frmDisasm.Disassemble(Code + Ps, Adr, @DisInfo, Nil); + recN := GetInfoRec(DisInfo.Immediate); + if Assigned(recN) then Begin - //jmp HandleOnException - Inc(Ps, instrLen1); - Inc(Adr, instrLen1); - //dd num - num := PInteger(Code + Ps)^; - Inc(Ps, 4); - if Adr + 4 + 8 * num > lastAdr then lastAdr := Adr + 4 + 8 * num; - for k := 0 to num-1 do + if recN.SameName('@HandleFinally') then Begin - //dd offset ExceptionInfo - Adr := PInteger(Code + Ps)^; - Inc(Ps, 4); - if IsValidImageAdr(Adr) then - Begin - recN1 := GetInfoRec(Adr); - if Assigned(recN1) and (recN1.kind = ikVMT) then clsName := recN1.Name; - End; - //dd offset ExceptionProc - procAdr := PInteger(Code + Ps)^; + //jmp HandleFinally + Inc(Ps, instrLen1); + Inc(Adr, instrLen1); + //jmp @2 + instrLen2 := frmDisasm.Disassemble(Code + Ps, Adr, @DisInfo, Nil); + Inc(Adr, instrLen2); + if Adr > lastAdr then lastAdr := Adr; + End + else if recN.SameName('@HandleAnyException') or recN.SameName('@HandleAutoException') then + Begin + //jmp HandleAnyException + Inc(Ps, instrLen1); + Inc(Adr, instrLen1); + //call DoneExcept + instrLen2 := frmDisasm.Disassemble(Code + Ps, Adr, Nil, Nil); + Inc(Adr, instrLen2); + if Adr > lastAdr then lastAdr := Adr; + End + else if recN.SameName('@HandleOnException') then + Begin + //jmp HandleOnException + Inc(Ps, instrLen1); + Inc(Adr, instrLen1); + //dd num + num := PInteger(Code + Ps)^; Inc(Ps, 4); - if IsValidImageAdr(procAdr) then + if Adr + 4 + 8 * num > lastAdr then lastAdr := Adr + 4 + 8 * num; + for k := 0 to num-1 do Begin - //Save context - if GetCtx(sctx, procAdr)=Nil then + //dd offset ExceptionInfo + Adr := PInteger(Code + Ps)^; + Inc(Ps, 4); + if IsValidImageAdr(Adr) then + Begin + recN1 := GetInfoRec(Adr); + if Assigned(recN1) and (recN1.kind = ikVMT) then clsName := recN1.Name; + End; + //dd offset ExceptionProc + procAdr := PInteger(Code + Ps)^; + Inc(Ps, 4); + if IsValidImageAdr(procAdr) then Begin - New(rcinfo); - rcinfo.sp := sp; - rcinfo.adr := procAdr; - for n := Low(Registers) to High(Registers) do rcinfo.registers[n] := registers[n]; - //eax - rcinfo.registers[16].value := GetClassAdr(clsName); - rcinfo.registers[16]._type := clsName; - sctx.Add(rcinfo); + //Save context + if GetCtx(sctx, procAdr)=Nil then + Begin + New(rcinfo); + rcinfo.sp := sp; + rcinfo.adr := procAdr; + for n := Low(Registers) to High(Registers) do rcinfo.registers[n] := registers[n]; + //eax + rcinfo.registers[16].value := GetClassAdr(clsName); + rcinfo.registers[16]._type := clsName; + sctx.Add(rcinfo); + End; End; End; End; End; End; End; - End; - Inc(curPos, instrLen); + end; + Inc(curPos, instrLen); Inc(curAdr, instrLen); continue; End; @@ -13880,12 +13986,12 @@ procedure TFMain.lbXrefsDrawItem(Control: TWinControl; Index:Integer; Rect:TRect typeName := TrimTypeName(registers[DisInfo.BaseReg]._type); if (typeName <> '') and (callOfs > 0) then Begin - Ps := GetNearestUpInstruction(curPos, fromPos, 1); + Ps := GetNearestUpInstruction(curPos, fromPos, 1); Adr := Pos2Adr(Ps); instrLen1 := frmDisasm.Disassemble(Code + Ps, Adr, @DisInfo, Nil); if DisInfo.Offset = callOfs + 4 then Begin - fInfo := GetField(typeName, callOfs, vmt, vmtAdr); + fInfo := GetField(typeName, callOfs, vmt, vmtAdr,''); if Assigned(fInfo) then Begin if fInfo.Name <> '' then AddPicode(curPos, OP_CALL, typeName + '.' + fInfo.Name, 0); @@ -13908,7 +14014,7 @@ procedure TFMain.lbXrefsDrawItem(Control: TWinControl; Index:Integer; Rect:TRect SetRegisterSource(registers, 17, #0); SetRegisterSource(registers, 18, #0); SetRegisterValue(registers, 16, -1); - Inc(curPos, instrLen); + Inc(curPos, instrLen); Inc(curAdr, instrLen); continue; End; @@ -13916,7 +14022,7 @@ procedure TFMain.lbXrefsDrawItem(Control: TWinControl; Index:Integer; Rect:TRect //floating point operations if DisInfo.Float then Begin - case DisInfo.MemSize of + case DisInfo.OpSize of 4: sType := 'Single'; //Double or Comp??? 8: sType := 'Double'; @@ -13932,10 +14038,10 @@ procedure TFMain.lbXrefsDrawItem(Control: TWinControl; Index:Integer; Rect:TRect Begin if _ap >= 0 then Begin - case DisInfo.MemSize of + case DisInfo.OpSize of 4: begin - singleVal := 0; + singleVal := 0; MoveMemory(@singleVal, Code + _ap, 4); fVal := FloatToStr(singleVal); end; @@ -13951,7 +14057,7 @@ procedure TFMain.lbXrefsDrawItem(Control: TWinControl; Index:Integer; Rect:TRect fVal := 'Impossible!'; end; End; - SetFlags([cfData], _ap, DisInfo.MemSize); + SetFlags([cfData], _ap, DisInfo.OpSize); recN := GetInfoRec(Adr); if not Assigned(recN) then recN := InfoRec.Create(_ap, ikData); @@ -13975,7 +14081,7 @@ procedure TFMain.lbXrefsDrawItem(Control: TWinControl; Index:Integer; Rect:TRect if bpBased and (DisInfo.BaseReg = 21) and (DisInfo.Offset < 0) then Begin recN1 := GetInfoRec(fromAdr); - recN1.procInfo.AddLocal(DisInfo.Offset, DisInfo.MemSize, '', sType); + recN1.procInfo.AddLocal(DisInfo.Offset, DisInfo.OpSize, '', sType); End //fxxx [esp + Offset] else if DisInfo.BaseReg = 20 then dummy := 1 @@ -14009,7 +14115,7 @@ procedure TFMain.lbXrefsDrawItem(Control: TWinControl; Index:Integer; Rect:TRect typeName := TrimTypeName(registers[DisInfo.BaseReg]._type); if typeName <> '' then Begin - fInfo := GetField(typeName, DisInfo.Offset, vmt, vmtAdr); + fInfo := GetField(typeName, DisInfo.Offset, vmt, vmtAdr,''); if Assigned(fInfo) then Begin if vmt then @@ -14100,7 +14206,7 @@ procedure TFMain.lbXrefsDrawItem(Control: TWinControl; Index:Integer; Rect:TRect typeName := TrimTypeName(registers[DisInfo.BaseReg]._type); if typeName <> '' then Begin - fInfo := GetField(typeName, DisInfo.Offset, vmt, vmtAdr); + fInfo := GetField(typeName, DisInfo.Offset, vmt, vmtAdr,''); if Assigned(fInfo) then Begin if vmt then @@ -14156,7 +14262,7 @@ procedure TFMain.lbXrefsDrawItem(Control: TWinControl; Index:Integer; Rect:TRect Begin if (typeName <> '') and (source <> 'v') then Begin - fInfo := GetField(typeName, DisInfo.Immediate, vmt, vmtAdr); + fInfo := GetField(typeName, DisInfo.Immediate, vmt, vmtAdr,''); if Assigned(fInfo) then Begin registers[reg1Idx]._type := fInfo._Type; @@ -14543,7 +14649,7 @@ procedure TFMain.lbXrefsDrawItem(Control: TWinControl; Index:Integer; Rect:TRect else Begin recN1 := GetInfoRec(fromAdr); - locInfo := recN1.procInfo.AddLocal(DisInfo.Offset, DisInfo.MemSize, '', ''); + locInfo := recN1.procInfo.AddLocal(DisInfo.Offset, DisInfo.OpSize, '', ''); //mov, xchg if (op = OP_MOV) or (op = OP_XCHG) then SetRegisterType(registers, reg1Idx, locInfo.TypeDef) @@ -14669,16 +14775,17 @@ procedure TFMain.lbXrefsDrawItem(Control: TWinControl; Index:Integer; Rect:TRect End; if typeName <> '' then Begin - fInfo := GetField(typeName, DisInfo.Offset, vmt, vmtAdr); + fInfo := GetField(typeName, DisInfo.Offset, vmt, vmtAdr,''); if Assigned(fInfo) then Begin if (op = OP_MOV) or (op = OP_XCHG) then registers[reg1Idx]._type := fInfo._Type; - if CanReplace(fInfo._Type, sType) then fInfo._Type := sType; if vmt then + begin + if CanReplace(fInfo._Type, sType) then fInfo._Type := sType; AddFieldXref(fInfo, fromAdr, curAdr - fromAdr, 'C') - else - fInfo.Free; + end + else fInfo.Free; //if (vmtAdr) typeName := GetClsName(vmtAdr); AddPicode(curPos, 0, typeName, DisInfo.Offset); End @@ -14824,7 +14931,7 @@ procedure TFMain.lbXrefsDrawItem(Control: TWinControl; Index:Integer; Rect:TRect if bpBased and (DisInfo.BaseReg = 21) and (DisInfo.Offset < 0) then Begin recN1 := GetInfoRec(fromAdr); - recN1.procInfo.AddLocal(DisInfo.Offset, DisInfo.MemSize, '', ''); + recN1.procInfo.AddLocal(DisInfo.Offset, DisInfo.OpSize, '', ''); End //cop [esp], Imm else if DisInfo.BaseReg = 20 then dummy := 1 @@ -14858,7 +14965,7 @@ procedure TFMain.lbXrefsDrawItem(Control: TWinControl; Index:Integer; Rect:TRect typeName := TrimTypeName(registers[DisInfo.BaseReg]._type); if typeName <> '' then Begin - fInfo := GetField(typeName, DisInfo.Offset, vmt, vmtAdr); + fInfo := GetField(typeName, DisInfo.Offset, vmt, vmtAdr,''); if Assigned(fInfo) then Begin if vmt then @@ -14980,7 +15087,7 @@ procedure TFMain.lbXrefsDrawItem(Control: TWinControl; Index:Integer; Rect:TRect if typeName <> '' then Begin if registers[reg2Idx]._type <> '' then sType := registers[reg2Idx]._type; - fInfo := GetField(typeName, DisInfo.Offset, vmt, vmtAdr); + fInfo := GetField(typeName, DisInfo.Offset, vmt, vmtAdr,''); if Assigned(fInfo) then Begin if vmt then @@ -15010,7 +15117,7 @@ procedure TFMain.lbXrefsDrawItem(Control: TWinControl; Index:Integer; Rect:TRect if typeName <> '' then Begin if registers[reg2Idx]._type <> '' then sType := registers[reg2Idx]._type; - fInfo := GetField(typeName, DisInfo.Offset, vmt, vmtAdr); + fInfo := GetField(typeName, DisInfo.Offset, vmt, vmtAdr,''); if Assigned(fInfo) then Begin if vmt then @@ -16097,6 +16204,7 @@ procedure TFMain.lbXrefsDrawItem(Control: TWinControl; Index:Integer; Rect:TRect b1 := Byte(Code[curPos]); b2 := Byte(Code[curPos + 1]); + If (b1=0)and(b2=0)and(lastAdr=0) then break; instrLen := frmDisasm.Disassemble(Code + curPos, curAdr, @DisInfo, Nil); //if (!instrLen) break; if instrLen=0 then @@ -16424,64 +16532,61 @@ procedure TFMain.lbXrefsDrawItem(Control: TWinControl; Index:Integer; Rect:TRect ) or (Code[NPos] = #$C3) then Begin Adr := DisInfo.Immediate; //Adr:=@1 - if Adr > lastAdr then lastAdr := Adr; - Ps := Adr2Pos(Adr); - assert(Ps >= 0); - - //recN1 := GetInfoRec(Adr); - //if (!recN1) recN1 := new InfoRec(Pos, ikTry); - //recN1.AddXref('C', fromAdr, Adr - fromAdr); - delta := Ps - NPos; - if (delta >= 0) and (delta < MAX_DISASSEMBLE) then - Begin - if Code[Ps] = #$E9 then //jmp Handle... + if IsValidCodeAdr(Adr) Then + begin + if Adr > lastAdr then lastAdr := Adr; + Ps := Adr2Pos(Adr); + if (Ps >= 0) and (Ps - NPos < MAX_DISASSEMBLE) then Begin - //Disassemble jmp - instrLen1 := frmDisasm.Disassemble(Code + Ps, Adr, @DisInfo, Nil); - recN1 := GetInfoRec(DisInfo.Immediate); - if Assigned(recN1) then + if Code[Ps] = #$E9 then //jmp Handle... Begin - if recN1.SameName('@HandleFinally') then - Begin - //ret + jmp HandleFinally - Inc(Ps, instrLen1); - Inc(Adr, instrLen1); - //jmp @2 - instrLen2 := frmDisasm.Disassemble(Code + Ps, Adr, @DisInfo, Nil); - Inc(Adr, instrLen2); - if Adr > lastAdr then lastAdr := Adr; - End - else if recN1.SameName('@HandleAnyException') or recN1.SameName('@HandleAutoException') then - Begin - //jmp HandleAnyException - Inc(Ps, instrLen1); - Inc(Adr, instrLen1); - //call DoneExcept - instrLen2 := frmDisasm.Disassemble(Code + Ps, Adr, Nil, Nil); - Inc(Adr, instrLen2); - if Adr > lastAdr then lastAdr := Adr; - End - else if recN1.SameName('@HandleOnException') then + //Disassemble jmp + instrLen1 := frmDisasm.Disassemble(Code + Ps, Adr, @DisInfo, Nil); + recN1 := GetInfoRec(DisInfo.Immediate); + if Assigned(recN1) then Begin - //jmp HandleOnException - Inc(Ps, instrLen1); - Inc(Adr, instrLen1); - //dd num - num := PInteger(Code + Ps)^; - Inc(Ps, 4); - if Adr + 4 + 8 * num > lastAdr then lastAdr := Adr + 4 + 8 * num; - for k := 0 to num-1 do + if recN1.SameName('@HandleFinally') then Begin - //dd offset ExceptionInfo - Inc(Ps, 4); - //dd offset ExceptionProc + //ret + jmp HandleFinally + Inc(Ps, instrLen1); + Inc(Adr, instrLen1); + //jmp @2 + instrLen2 := frmDisasm.Disassemble(Code + Ps, Adr, @DisInfo, Nil); + Inc(Adr, instrLen2); + if Adr > lastAdr then lastAdr := Adr; + End + else if recN1.SameName('@HandleAnyException') or recN1.SameName('@HandleAutoException') then + Begin + //jmp HandleAnyException + Inc(Ps, instrLen1); + Inc(Adr, instrLen1); + //call DoneExcept + instrLen2 := frmDisasm.Disassemble(Code + Ps, Adr, Nil, Nil); + Inc(Adr, instrLen2); + if Adr > lastAdr then lastAdr := Adr; + End + else if recN1.SameName('@HandleOnException') then + Begin + //jmp HandleOnException + Inc(Ps, instrLen1); + Inc(Adr, instrLen1); + //dd num + num := PInteger(Code + Ps)^; Inc(Ps, 4); + if Adr + 4 + 8 * num > lastAdr then lastAdr := Adr + 4 + 8 * num; + for k := 0 to num-1 do + Begin + //dd offset ExceptionInfo + Inc(Ps, 4); + //dd offset ExceptionProc + Inc(Ps, 4); + End; End; End; End; End; - End; - Inc(curPos, instrLen); + end; + Inc(curPos, instrLen); Inc(curAdr, instrLen); continue; End; @@ -16552,7 +16657,7 @@ procedure TFMain.lbXrefsDrawItem(Control: TWinControl; Index:Integer; Rect:TRect // that popped from stack by instrcution POP ECX if not emb or (DisInfo.Offset <> retBytes + bpBase) then Begin - argSize := DisInfo.MemSize; + argSize := DisInfo.OpSize; argType := ''; if argSize = 10 then argType := 'Extended'; //Each argument in stack has size 4*N bytes @@ -17183,9 +17288,14 @@ procedure TFMain.FormCloseQuery(Sender : TObject; Var CanClose:Boolean); begin if Assigned(AnalyzeThread) then begin + AnalyzeThread.Suspend; + pb.Visible:=False; res := Application.MessageBox('Analysis is not yet completed. Do You really want to exit IDR?', 'Confirmation', MB_YESNO); if res = IDNO then begin + pb.Visible:=True; + pb.Update; + AnalyzeThread.Resume; CanClose := false; Exit; end; @@ -17293,12 +17403,11 @@ procedure TFMain.miEmptyHistoryClick(Sender : TObject); CodeHistoryMax := CodeHistoryPtr; end; -Function TFMain.GetField (TypeName:AnsiString; Offset:Integer; Var vmt:Boolean; Var vmtAdr:Integer):FieldInfo; +function TFMain.GetField(TypeName:AnsiString; Offset:Integer; var vmt:Boolean; var vmtAdr:Integer;Prefix:AnsiString): FieldInfo; var - scope:Byte; kind:LKind; - n, idx, size, Ofs, classAdr,prevClassAdr:Integer; - p:PAnsiChar; + n, idx, size, Ofs, Ofs1, Ofs2, classAdr,prevClassAdr:Integer; + p,ps:PAnsiChar; Len:Word; use:TWordDynArray; tInfo:MTypeInfo; @@ -17311,7 +17420,7 @@ procedure TFMain.miEmptyHistoryClick(Sender : TObject); classAdr := GetClassAdr(TypeName); if IsValidImageAdr(classAdr) then Begin - vmt := true; + vmt := true; vmtAdr := classAdr; prevClassAdr := 0; while (classAdr<>0) and (Offset < GetClassSize(classAdr)) do @@ -17322,15 +17431,16 @@ prevClassAdr := classAdr; classAdr := prevClassAdr; if classAdr<>0 then Begin + vmtAdr:=classAdr; recN := GetInfoRec(classAdr); - if Assigned(recN) and Assigned(recN.vmtInfo.fields) then + if Assigned(recN) and Assigned(recN.vmtInfo) and Assigned(recN.vmtInfo.fields) then Begin if recN.vmtInfo.fields.Count = 1 then Begin fInfo := FieldInfo(recN.vmtInfo.fields[0]); if Offset = fInfo.Offset then Begin - vmtAdr := classAdr; + fInfo.Name:=prefix+'.'+fInfo.Name; Result:=fInfo; Exit; End; @@ -17339,24 +17449,42 @@ vmtAdr := classAdr; for n := 0 to recN.vmtInfo.fields.Count - 2 do Begin fInfo1 := FieldInfo(recN.vmtInfo.fields[n]); - fInfo2 := FieldInfo(recN.vmtInfo.fields[n + 1]); - if (Offset >= fInfo1.Offset) and (Offset < fInfo2.Offset) then + Ofs1:=fInfo1.Offset; + if n=recN.vmtInfo.fields.Count-1 then Ofs2:=GetClassSize(classAdr) + Else + begin + fInfo2 := FieldInfo(recN.vmtInfo.fields[n + 1]); + Ofs2:=fInfo2.Offset; + end; + if (Offset >= Ofs1) and (Offset < Ofs2) then Begin - if Offset = fInfo1.Offset then + if Offset = Ofs1 then Begin - vmtAdr := classAdr; Result:=fInfo1; Exit; End; kind := GetTypeKind(fInfo1._Type, size); - if (kind = ikRecord) or (kind = ikArray) then + if (kind = ikClass) Or (kind = ikRecord) then + Begin + prefix := fInfo1.Name; + fInfo := GetField(fInfo1._Type, Offset - Ofs1, vmt, vmtAdr, prefix); + if Assigned(fInfo) then + begin + fInfo.Offset := Offset; + fInfo.Name := prefix + '.' + fInfo.Name; + Result:=fInfo; + end + else Result:=Nil; + Exit; + End + Else if kind = ikArray then Begin - vmtAdr := classAdr; Result:= fInfo1; Exit; - End; + end; End; End; + { fInfo := FieldInfo(recN.vmtInfo.fields[recN.vmtInfo.fields.Count - 1]); if Offset >= fInfo.Offset then Begin @@ -17374,6 +17502,7 @@ vmtAdr := classAdr; Exit; End; End; + } End; End; Exit; @@ -17385,7 +17514,6 @@ vmtAdr := classAdr; use:=Nil; if idx <> -1 then Begin - fInfo := Nil; idx := KBase.TypeOffsets[idx].NamId; if KBase.GetTypeInfo(idx, [INFO_FIELDS], tInfo) then if Assigned(tInfo.Fields) then @@ -17393,40 +17521,42 @@ vmtAdr := classAdr; p := tInfo.Fields; for n := 0 to tInfo.FieldsNum-1 do Begin - //Scope - scope := Byte(p^); - Inc(p); + ps:=p; + Inc(p); // skip scope //offset - Ofs := PInteger(p)^; - Inc(p, 4); - if Ofs = Offset then + Ofs1 := PInteger(p)^; + Inc(p, 4); // case + Len := PWord(p)^; + Inc(p, Len + 3);//name + Len := PWord(p)^; + Inc(p, Len + 3);//type + if n = tInfo.FieldsNum - 1 then Ofs2 := 0 + else Ofs2 := PInteger(p + 1)^; + + if (Offset >= Ofs1) And (Offset < Ofs2) then Begin + p:=ps; + Inc(ps); // scope + Ofs:=PInteger(p)^; + Inc(p,4); // offset fInfo:=FieldInfo.Create; - fInfo.Scope := scope; - fInfo._Case := PInteger(p)^; + fInfo.Offset:=Offset - Ofs; + fInfo.Scope := SCOPE_TMP; + fInfo._Case := PInteger(p)^; Inc(p, 4); fInfo.xrefs := Nil; - Len := PWord(p)^; + Len := PWord(p)^; Inc(p, 2); - fInfo.Name := MakeString(p, Len); + fInfo.Name := MakeString(p, Len); Inc(p, Len + 1); - Len := PWord(p)^; + Len := PWord(p)^; Inc(p, 2); fInfo._Type := TrimTypeName(MakeString(p, Len)); - break; - End - else - Begin - Inc(p, 4); - Len := PWord(p)^; - Inc(p, 2); - Inc(p, Len + 1); - Len := PWord(p)^; - Inc(p, 2); - Inc(p, Len + 1); + Result:=fInfo; + Exit; End; End; - Result:= fInfo; + Result:= Nil; Exit; End; End; @@ -17452,7 +17582,7 @@ prevClassAdr := classAdr; if classAdr<>0 then begin recN := GetInfoRec(classAdr); - if Assigned(recN) then Result:=recN.vmtInfo.AddField(ProcAdr, ProcOfs, Scope, Offset, _Case, Name, _Type); + if Assigned(recN) and Assigned(recN.vmtInfo) then Result:=recN.vmtInfo.AddField(ProcAdr, ProcOfs, Scope, Offset, _Case, Name, _Type); Exit; end; end; @@ -18102,7 +18232,7 @@ procedure TFMain.miSaveDelphiProjectClick(Sender : TObject); var _expExists,typePresent, _isForm, comment:Boolean; kind:LKind; - n, m, num, dotpos, len, minValue, maxValue:Integer; + n, m, k, num, dotpos, len, minValue, maxValue:Integer; adr, adr1, parentAdr:Integer; f:TextFile; tmpList:TList; @@ -18114,10 +18244,11 @@ procedure TFMain.miSaveDelphiProjectClick(Sender : TObject); recE:PExportNameRec; fInfo:FieldInfo; recM:PMethodRec; + recV:PVmtListRec; dfm:TDfm; cInfo:PComponentInfo; curDir, DelphiProjectPath, unitName, clsName, parentName, fieldName:AnsiString; - typeName, procName, formName, dfmName, line:AnsiString; + typeName, procName, formName, dfmName, line, uName:AnsiString; begin curDir := GetCurrentDir; DelphiProjectPath := AppDir + 'Projects'; @@ -18222,6 +18353,18 @@ intBodyLines.Add(' '+clsName+' = class('+parentName+')'); comment := true; typeName := '?'; End; + //Add UnitName to UsesList if necessary + for k := 0 to VmtList.Count-1 do + begin + recV := VmtList[k]; + if Assigned(recV) and SameText(typeName, recV.vmtName) then + begin + uName := GetUnitName(recV.vmtAdr); + if intUsesLines.IndexOf(uName) = -1 then + intUsesLines.Add(uName); + break; + end; + end; if not comment then line := Format(' %s:%s;//f%X', [fieldName, typeName, fInfo.Offset]) else @@ -18881,6 +19024,85 @@ procedure TFMain.miProcessDumperClick(Sender : TObject); FActiveProcesses.ShowModal; end; +procedure TFMain.lbSourceCodeClick(Sender: TObject); +var + text,prevItem:AnsiString; + x,n,beg,stop,Len,wid:Integer; +begin + WhereSearch:=SEARCH_SOURCEVIEWER; + if lbSourceCode.ItemIndex=-1 then Exit; + prevItem := SelectedSourceItem; + SelectedSourceItem := ''; + text := lbSourceCode.Items[lbSourceCode.ItemIndex]; + Len := Length(text); + x := lbSourceCode.ScreenToClient(Mouse.CursorPos).x; + wid:=0; + for n := 1 to Len do + begin + if wid > x then + begin + beg:=n - 1; + while beg >= 1 do + begin + if not (text[beg] in ['@','0'..'9','A'..'Z','a'..'z']) then + begin + Inc(beg); + break; + End; + Dec(beg); + end; + stop:=beg; + while stop <= Len do + begin + if not (text[stop] in ['@','0'..'9','A'..'Z','a'..'z']) then + begin + Dec(stop); + break; + end; + Inc(stop); + end; + SelectedSourceItem := Copy(text,beg, stop - beg + 1); + break; + end; + Inc(wid, lbSourceCode.Canvas.TextWidth(text[n])); + end; + if SelectedSourceItem <> prevItem then lbSourceCode.Invalidate; +end; + +procedure TFMain.SetLvartypeClick(Sender: TObject); +var + recN:InfoRec; + locInfo:PLocalInfo; + ftype:AnsiString; +begin + recN:=GetInfoRec(CurProcAdr); + locInfo:=recN.procInfo.GetLocal(SelectedSourceItem); + if Assigned(recN) and Assigned(recN.procInfo.locals) and (SelectedSourceItem <> '') then + begin + ftype:=Trim(InputDialogExec('Enter type of '+SelectedSourceItem,'Type',locInfo.TypeDef)); + locInfo.TypeDef:=ftype; + recN.procInfo.SetLocalType(locInfo.Ofs,ftype); + bDecompileClick(Sender); + end; +end; + +procedure TFMain.pmSourceCodePopup(Sender: TObject); +var + locInfo:PLocalInfo; + recN:InfoRec; +begin + locInfo:=Nil; + recN:=GetInfoRec(CurProcAdr); + if Assigned(recN) and Assigned(recN.procInfo.locals) and (SelectedSourceItem <> '') then + locInfo:=recN.procInfo.GetLocal(SelectedSourceItem); + miSetLvartype.Enabled:=Assigned(locInfo); +end; + +procedure TFMain.miCopytoClipboardNamesClick(Sender: TObject); +begin + vtName.CopyToClipBoard; +end; + procedure TFMain.vtProcClick(Sender: TObject); begin UnitItemsSearchFrom := vtProc.FocusedNode; @@ -19052,6 +19274,7 @@ procedure TFMain.vtProcDblClick(Sender: TObject); ShowClassViewer(dat.adres); Exit; End + else If IsFlagSet([cfRTTI],ps) then FTypeInfo.ShowRTTI(Dat.adres) else if dat.pkind = ikResString then Begin FStringInfo.memStringInfo.Clear; @@ -19366,7 +19589,7 @@ procedure TFMain.vtUnitDblClick(Sender: TObject); if (CurUnitAdr=0) or (recU.fromAdr <> CurUnitAdr) then begin CurUnitAdr := recU.fromAdr; - ShowUnitItems(recU, 0, -1); + ShowUnitItems(recU, 0, MAXDWORD); end else Begin diff --git a/Misc.pas b/Misc.pas index 9a3684e..a3b4a6c 100644 --- a/Misc.pas +++ b/Misc.pas @@ -63,6 +63,10 @@ function GetNearestUpInstruction1(fromPos, toPos:Integer; Instruction:AnsiString Function GetParentSize(Adr:Integer):Integer; Function GetProcRetBytes(pInfo:MProcInfo):Integer; Function GetProcSize(fromAdr:Integer):Integer; +function StrGetRecordSize(const str:AnsiString): Integer; +function StrGetRecordFieldOffset(const str:AnsiString): Integer; +function StrGetRecordFieldName(const str:AnsiString): AnsiString; +function StrGetRecordFieldType(const str:AnsiString): AnsiString; Function GetRecordSize(AName:AnsiString):Integer; Function GetRecordFields(AOfs:Integer; ARecType:AnsiString):AnsiString; Function GetAsmRegisterName(Idx:Integer):AnsiString; @@ -73,6 +77,7 @@ function GetNearestUpInstruction1(fromPos, toPos:Integer; Instruction:AnsiString Function GetOwnTypeByName(AName:AnsiString):PTypeRec; Function GetTypeDeref(ATypeName:AnsiString):AnsiString; Function GetTypeKind(AName:AnsiString; var size:Integer):LKind; +Function GetRTTIRecordSize(adr:Integer):Integer; Function GetPackedTypeSize(AName:AnsiString):Integer; Function GetTypeName(Adr:Integer):AnsiString; Function GetTypeSize(AName:AnsiString):Integer; @@ -86,6 +91,7 @@ function GetNearestUpInstruction1(fromPos, toPos:Integer; Instruction:AnsiString Function IsValidCodeAdr(Adr:Integer):Boolean; Function IsValidCString(p:Integer):Boolean; Function IsValidImageAdr(Adr:Integer):Boolean; +function IsValidModuleName(len, p:Integer): Boolean; Function IsValidName(len, p:Integer):Boolean; Function IsValidString(len, p:Integer):Boolean; Procedure MakeGvar(recN:InfoRec; adr, xrefAdr:Integer); @@ -102,6 +108,9 @@ procedure SetFlags(flag:TCFlagSet; p, num:Integer); Function TransformUString(codePage:Word; data:PWideChar; len:Integer):AnsiString; Function TrimTypeName(const TypeName:AnsiString):AnsiString; Function TypeKind2Name(kind:LKind):AnsiString; +function GetClassField(const TypeName:AnsiString;Offset:Integer): FieldInfo; +function GetRecordField(ARecType:AnsiString;AOfs:Integer;Var name,_type:AnsiString): Integer; +function GetField(const TypeName:AnsiString;Offset:Integer;Var name,_type:AnsiString): Integer; //Decompiler Function InputDialogExec(caption, labelText, text:AnsiString):AnsiString; @@ -303,6 +312,7 @@ implementation Inc(p); locflags := PInteger(p)^; Inc(p,4); + If (locflags and 7) =1 then argInfo.tag:=$23; // Add by ZGL argInfo.in_Reg := (locflags and 8)<>0; ndx := PInteger(p)^; Inc(p, 4); @@ -611,7 +621,7 @@ implementation End; if (len<>0) and (DisInfo.Mnem=Instruction) then Begin - Result:= curPos + instrLen; + Result:= curPos {+ instrLen}; // removed by Crypto Exit; end; if DisInfo.Ret then break; @@ -706,6 +716,45 @@ implementation *) end; +Function StrGetRecordSize(const str:AnsiString):Integer; +var + bpos,epos:Integer; +Begin + Result:=0; + bpos:=Pos('size=',str); + epos:=LastDelimiter(#13,str); + If (bpos<>0)and(epos<>0) then Result:=StrToInt('$'+Copy(str,5+bpos,epos-bpos-5)); +end; + +Function StrGetRecordFieldOffset(const str:AnsiString):Integer; +var + bpos,epos:Integer; +Begin + Result:=-1; + bpos:=Pos('//',str); + epos:=LastDelimiter(#13,str); + If (bpos<>0)and(epos<>0) then Result:=StrToInt('$'+Copy(str,2+bpos,epos-bpos-2)); +end; + +Function StrGetRecordFieldName(const str:AnsiString):AnsiString; +var + p:Integer; +Begin + Result:=''; + p:=Pos(':',str); + if p<>0 then Result:=Copy(str,1,p-1); +end; + +Function StrGetRecordFieldType(const str:AnsiString):AnsiString; +var + bpos,epos:Integer; +Begin + Result:=''; + bpos:=Pos(':',str); + epos:=LastDelimiter(':',str); + If (bpos<>0)and(epos<>0) then Result:=Copy(str,1+bpos,epos-bpos-1); +end; + Function GetRecordSize (AName:AnsiString):Integer; var len:Byte; @@ -730,12 +779,8 @@ implementation Readln(recFile,str); if Pos(AName+'=',str) = 1 then begin - _pos := Pos('size=',str); - if _pos<>0 then - begin - sscanf(PAnsiChar(str)+_pos+5,'%lX',[@Result]); - Exit; - End; + Result:=StrGetRecordSize(str); + Exit; End; end; Finally @@ -769,22 +814,70 @@ implementation End; end; -Function GetRecordFields (AOfs:Integer; ARecType:AnsiString):AnsiString; -var - len, numOps:Byte; +Function GetClassField(const TypeName:AnsiString;Offset:Integer):FieldInfo; +var + n,ofs1,ofs2,classAdr,prevAdr:Integer; + recN:InfoRec; + fInfo1,fInfo2:FieldInfo; +Begin + Result:=Nil; + prevAdr:=0; + classAdr:=GetClassAdr(TypeName); + while (classAdr<>0)and(Offset < GetClassSize(classAdr)) do + Begin + prevAdr:=classAdr; + classAdr:=GetParentAdr(classAdr); + end; + classAdr:=prevAdr; + If classAdr<>0 Then + Begin + recN := GetInfoRec(classAdr); + if Assigned(recN) and Assigned(recN.vmtInfo) and Assigned(recN.vmtInfo.fields) then + begin + for n := 0 to recN.vmtInfo.fields.Count-1 Do + begin + fInfo1 := FieldInfo(recN.vmtInfo.fields[n]); + Ofs1 := fInfo1.Offset; + if n = recN.vmtInfo.fields.Count - 1 then Ofs2 := GetClassSize(classAdr) + else + begin + fInfo2 := FieldInfo(recN.vmtInfo.fields[n + 1]); + Ofs2 := fInfo2.Offset; + end; + if (Offset >= Ofs1) and (Offset < Ofs2) then + begin + Result:=fInfo1; + Exit; + end; + end; + end; + end; +end; + +Function GetRecordField(ARecType:AnsiString;AOfs:Integer;Var name,_type:AnsiString):Integer; +var + brk:Boolean; + numOps:Byte; kind:LKind; - p:PAnsiChar; - dw, len1:Word; - _uses:TWordDynArray; - i, k, _idx, _pos, _elNum, _elOfs, _size, _case, _offset:Integer; - typeAdr:Integer; - recT:PTypeRec; - tInfo:MTypeInfo; - str, _name, _typeName:AnsiString; + p, ps:PAnsiChar; + dw,len:WORD; + _uses:TWordDynArray; + n, m, k, _idx, _pos, _elNum, Ofs, Ofs1, Ofs2, _case, _fieldsNum, size:Integer; + tries,typeAdr:Integer; + recT:PTypeRec; + tInfo:MTypeInfo; recFile:Text; -Begin - Result:=''; + str, prevStr, _name, _typeName, _ofs, _sz, _result:AnsiString; + _fieldOfsets:Array[0..1024] of Integer; + _cases:Array[0..256] of CaseInfo; +Begin + _result:=''; + Result:=-1; if ARecType = '' then Exit; + _name:=''; + _typeName:=''; + _pos:=LastDelimiter('.',ARecType); + if (_pos>1)and(ARecType[_pos+1] <> ':') then ARecType:=Copy(ARecType,_pos+1,Length(ARecType)); //File str:=FMain.WrkDir + '\types.idr'; if FileExists(str) Then @@ -797,73 +890,133 @@ implementation Readln(recFile,str); if Pos(ARecType+'=',str) = 1 then begin + size:=StrGetRecordSize(str); + prevStr:=''; + brk:=false; while not eof(recFile) do begin Readln(recFile,str); - if Pos('end;',str)<>0 then break; - if Pos('//' + Val2Str(AOfs),str)<>0 then + Ofs1:=StrGetRecordFieldOffset(prevStr); + if Pos('end;',str)<>0 then + Begin + Ofs2:=size; + brk:=True; + end + else Ofs2:=StrGetRecordFieldOffset(str); + If (Ofs1>=0)and(AOfs>=Ofs1)and(AOfs0 then SetLength(Result,_pos - 1); + name:=StrGetRecordFieldName(prevStr); + _type:=StrGetRecordFieldType(prevStr); + result := Ofs1; Exit; End; + if brk then break; + prevStr:=str; End; + break; End; End; Finally closeFile(recFile); end; end; - //KB - _uses := KBase.GetTypeUses(PAnsiChar(ARecType)); - _idx := KBase.GetTypeIdxByModuleIds(_uses, PAnsiChar(ARecType)); - _uses:=Nil; - if _idx <> -1 then + tries:=5; + while(tries>=0) do begin - _idx := KBase.TypeOffsets[_idx].NamId; - if KBase.GetTypeInfo(_idx, [INFO_FIELDS], tInfo) then + Dec(tries); + //KB + _uses := KBase.GetTypeUses(PAnsiChar(ARecType)); + _idx := KBase.GetTypeIdxByModuleIds(_uses, PAnsiChar(ARecType)); + _uses:=Nil; + if _idx <> -1 then begin - if tInfo.FieldsNum<>0 then + _idx := KBase.TypeOffsets[_idx].NamId; + if KBase.GetTypeInfo(_idx, [INFO_FIELDS], tInfo) then begin - p := tInfo.Fields; - for k := 1 to tInfo.FieldsNum do + if tInfo.FieldsNum<>0 then begin - //Scope - Inc(p); - _offset := PInteger(p)^; - Inc(p, 4); - _case := PInteger(p)^; - Inc(p, 4); - //Name - len1 := PWord(p)^; - Inc(p, 2); - _name := MakeString(p, len1); - Inc(p, len1 + 1); - //Type - len1 := PWord(p)^; - Inc(p, 2); - _typeName := TrimTypeName(MakeString(p, len1)); - Inc(p, len1 + 1); - kind := GetTypeKind(_typeName, _size); - if kind = ikRecord then + FillChar(_cases,SizeOf(_cases),0); + p := tInfo.Fields; + m:=0; + for n := 0 to tInfo.FieldsNum-1 do begin - _size := GetRecordSize(_typeName); - if (AOfs >= _offset) and (AOfs < _offset + _size) then - result:=result + _name + '.' + GetRecordFields(AOfs - _offset, _typeName); - end - else if (AOfs >= _offset) and (AOfs < _offset + _size) then - begin - if _size > 4 then - result := _name + '+' + IntToStr(AOfs - _offset) + ':' + _typeName - else - result := _name + ':' + _typeName; - End; - End; + Inc(p); // scope + Inc(p, 4); // offset + _case := PInteger(p)^; + Inc(p, 4); + if _cases[m].count=0 then _cases[m].caseno := _case + else if _cases[m].caseno <> _case Then + Begin + Inc(m); + _cases[m].caseno := _case; + end; + Inc(_cases[m].count); + // name + len := PWord(p)^; + Inc(p, len + 3); + //Type + len := PWord(p)^; + Inc(p, len + 3); + end; + For m:=Low(_cases) to High(_cases) do + if _cases[m].count<>0 then + Begin + p:=tInfo.Fields; + k:=0; + For n:=1 to tInfo.FieldsNum Do + Begin + ps:=p; + Inc(p); // scope + Ofs1 := PInteger(p)^; + Inc(p, 4); //offset + _case := PInteger(p)^; + Inc(p, 4); //case + len := PWord(p)^; + Inc(p, len + 3); //name + len := PWord(p)^; + Inc(p, len + 3); //type + if _case = _cases[m].caseno then + begin + if k = _cases[m].count - 1 then Ofs2 := GetRecordSize(ARecType) + else Ofs2 := PInteger(p + 1)^; + if (AOfs >= Ofs1) and (AOfs < Ofs2) then + begin + p := ps; + Inc(p); //scope + Ofs1 := PInteger(p)^; + Inc(p, 4); //offset + Inc(p, 4); //case + len := PWord(p)^; + Inc(p, 2); + name := MakeString(p, len); + Inc(p, len + 1); + len := PWord(p)^; + Inc(p, 2); + _type := MakeString(p, len); + Inc(p, len + 1); + Result:=Ofs1; + Exit; + end; + Inc(k); + end; + end; + end; + end + Else if tInfo.Decl <> '' then + Begin + ARecType:=tInfo.Decl; + { + Ofs:=GetRecordField(tInfo.Decl,AOfs,name,_type); + If Ofs >=0 then + Begin + Result:=Ofs; + Exit; + end; + } + end; End; End; - End; - if result <> '' Then Exit; + end; //RTTI recT := GetOwnTypeByName(ARecType); if Assigned(recT) and (recT.kind = ikRecord) then @@ -872,48 +1025,43 @@ implementation Inc(_pos, 4);//SelfPtr Inc(_pos);//TypeKind len := Byte(Code[_pos]); + _name:=MakeString(Code+_pos,len); Inc(_pos, len + 1);//Name Inc(_pos, 4);//Size _elNum := PInteger(Code + _pos)^; Inc(_pos, 4); - for i := 1 to _elNum do + for n := 1 to _elNum do begin typeAdr := PInteger(Code + _pos)^; Inc(_pos, 4); - _elOfs := PInteger(Code + _pos)^; + Ofs1:=PInteger(Code+_pos)^; Inc(_pos, 4); - _typeName := GetTypeName(typeAdr); - kind := GetTypeKind(_typeName, _size); - if kind = ikRecord then - begin - _size := GetRecordSize(_typeName); - if (AOfs >= _elOfs) and (AOfs < _elOfs + _size) then - result := 'f' + Val2Str(_elOfs) + '.' + GetRecordFields(AOfs - _elOfs, _typeName); - end - else if (AOfs >= _elOfs) and (AOfs < _elOfs + _size) then - begin - if _size > 4 then - result := 'f' + Val2Str(_elOfs) + '+' + IntToStr(AOfs - _elOfs) + ':' + _typeName - else - result := 'f' + Val2Str(_elOfs) + ':' + _typeName; - End; + if n = _elNum then Ofs2:=0 + else Ofs2:=PInteger(Code+_pos+4)^; + if (AOfs>=Ofs1)and(AOfs= 2010 then begin //NumOps numOps := Byte(Code[_pos]); Inc(_pos); - for i := 1 to numOps do //RecOps + for n := 1 to numOps do //RecOps Inc(_pos, 4); _elNum := PInteger(Code + _pos)^; Inc(_pos, 4); //RecFldCnt - for i := 1 to _elNum do + for n := 1 to _elNum do begin //TypeRef typeAdr := PInteger(Code + _pos)^; Inc(_pos, 4); //FldOffset - _elOfs := PInteger(Code + _pos)^; + Ofs1 := PInteger(Code + _pos)^; Inc(_pos, 4); //Flags Inc(_pos); @@ -922,29 +1070,90 @@ implementation Inc(_pos); _name := MakeString(Code + _pos, len); Inc(_pos, len); - _typeName := GetTypeName(typeAdr); - kind := GetTypeKind(_typeName, _size); - if kind = ikRecord then - begin - _size := GetRecordSize(_typeName); - if (AOfs >= _elOfs) and (AOfs < _elOfs + _size) then - result := _name + '.' + GetRecordFields(AOfs - _elOfs, _typeName); - end - else if (AOfs >= _elOfs) and (AOfs < _elOfs + _size) then - begin - if _size > 4 then - result := _name + '+' + IntToStr(AOfs - _elOfs) + ':' + _typeName - else - result := _name + ':' + _typeName; - End; //AttrData dw := PWord(Code + _pos)^; Inc(_pos, dw);//ATR!! + if n = _elNum then Ofs2:=0 + else Ofs2:=PInteger(Code+_pos+4)^; + if (AOfs>=Ofs1)and(AOfs'' then name:=_name Else name:='f'+Val2Str(Ofs1); + _type:=GetTypeName(typeAdr); + Result:=Ofs1; + Exit; + end; End; End; End; +end; + +Function GetField(const TypeName:AnsiString;Offset:Integer;Var name,_type:AnsiString):Integer; +var + Size,ofs:Integer; + kind:LKind; + fInfo:FieldInfo; + fname,ftype,tip:AnsiString; +Begin + tip:=TypeName; + fname:=''; + ftype:=''; + Result:=Offset; + while Result >= 0 do + begin + kind := GetTypeKind(_type, size); + case kind of + ikVMT: + begin + if Result=0 Then Exit; + fInfo := GetClassField(_type, Result); + if name <> '' Then name:=name + '.'; + if fInfo.Name <> '' then name:=name + fInfo.Name + else name:=name + 'f' + IntToHex(Result, 0); + tip := fInfo._Type; + _type := tip; + Dec(Result, fInfo.Offset); + { + if Result=0 then + Begin + Result:=fInfo.Offset; + Exit; + end; + } + End; + ikRecord: + begin + ofs := GetRecordField(_type, Result, fname, ftype); + if ofs = -1 Then + Begin + Result:=-1; + Exit; + end; + if name <> '' then name:=name + '.'; + name:=name + fname; + tip := ftype; + _type := ftype; + Dec(Result, ofs); + { + if Result=0 then + Begin + Result:=ofs; + Exit; + End; + } + end; + Else Break; + end; + end; end; - + +Function GetRecordFields (AOfs:Integer; ARecType:AnsiString):AnsiString; +var + name,TypeName:AnsiString; +Begin + if (ARecType='')or(GetField(ARecType,AOfs,name,TypeName) < 0) then Result:='' + Else Result:=name+':'+TypeName; +end; + Function GetAsmRegisterName (Idx:Integer):AnsiString; Begin Result:=''; @@ -970,6 +1179,21 @@ implementation End; end; +Function IsValidModuleName (len, p:Integer):Boolean; +var + i:Integer; + b:Char; +Begin + Result:=False; + if len=0 then Exit; + for i := P to p + len-1 do + begin + b := Code[i]; + if (b <' ')or(b>#127)or(b=':') then Exit; + End; + Result:=True; +end; + Function IsValidName (len, p:Integer):Boolean; var i:Integer; @@ -1208,7 +1432,7 @@ implementation begin c := p^; Inc(p); - if c in [' '..#126] then + if c in [' '..#126,'А'..'я'] then Begin if (z=1)or(Result='') then Result:=Result + COMENT_QUOTE; result:=result + c; @@ -1334,7 +1558,7 @@ implementation while classAdr<>0 do begin recN := GetInfoRec(classAdr); - if Assigned(recN) and Assigned(recN.vmtInfo.methods) then + if Assigned(recN) and Assigned(recN.vmtInfo) And Assigned(recN.vmtInfo.methods) then begin for m := 0 to recN.vmtInfo.methods.Count-1 do begin @@ -1457,12 +1681,28 @@ implementation Result:=''; end; +Function GetRTTIRecordSize(Adr:Integer):Integer; +var + len:Byte; + _pos,ap:Integer; + kind:LKind; +Begin + ap:=Adr2Pos(adr); + _pos:=ap; + Inc(_pos,4); + kind:=LKind(Code[_pos]); + Inc(_pos); + len:=Ord(Code[_pos]); + Inc(_pos,len+1); + if kind=ikRecord then Result:=PInteger(Code+_pos)^ else Result:=0; +end; + Function GetTypeKind (AName:AnsiString; Var size:Integer):LKind; var p, idx:Integer; _uses:TWordDynArray; tInfo:MTypeInfo; - name, str:AnsiString; + name, str,sz:AnsiString; recFile:Text; recT:PTypeRec; Begin @@ -1477,7 +1717,7 @@ implementation Else Result:=ikArray; Exit; end; - p := Pos('.',AName); + p := LastDelimiter('.',AName); if (p > 1) and (AName[p + 1] <> ':') then name := Copy(AName,p + 1, Length(AName)) else name := AName; @@ -1596,6 +1836,7 @@ implementation if Pos(AName + '=',str) = 1 then if Pos('=record',str)<>0 then begin + size:=StrGetRecordSize(str); REsult:=ikRecord; Exit; end; @@ -1608,7 +1849,8 @@ if Pos('=record',str)<>0 then recT := GetOwnTypeByName(name); if Assigned(recT) then begin - size := 4; + size := GetRTTIRecordSize(recT.adr); + if size=0 then size:=4; Result:=recT.kind; Exit; end; @@ -1661,6 +1903,11 @@ if Pos('=record',str)<>0 then Result:=ikRecord; Exit; end; + drInterfaceDef: // 0x54 + Begin + Result:=ikInterface; + Exit; + end; end; if tInfo.Decl <> '' then begin @@ -1858,6 +2105,7 @@ if Pos('=record',str)<>0 then if tInfo.Decl <> '' then begin e := 0; + b:=1; for n := 0 to _val do begin b := e + 1; @@ -2388,7 +2636,7 @@ if Pos('=record',str)<>0 then Begin Result:=False; for Idx := 0 to 7 do - if SameText(AName, '_' + Reg32Tab[Idx] + '_') Then + if SameText(AName, Reg32Tab[Idx]) Then Begin Result:=true; Exit; @@ -2404,6 +2652,7 @@ function FloatNameToFloatType(AName:AnsiString): TFloatKind; else if SameText(AName, 'Extended') then result:=FT_EXTENDED else if SameText(AName, 'Real') then Result:=FT_REAL else if SameText(AName, 'Comp') then result:=FT_COMP + else if SameText(AName, 'Currency') then result:=FT_CURRENCY else Result:=TFloatKind(-1); end; diff --git a/ProgressBar.dfm b/ProgressBar.dfm deleted file mode 100644 index 2cefa7a..0000000 --- a/ProgressBar.dfm +++ /dev/null @@ -1,25 +0,0 @@ -object FProgressBar: TFProgressBar - Left = 631 - Top = 461 - BorderIcons = [] - BorderStyle = bsNone - ClientHeight = 24 - ClientWidth = 328 - Color = clHighlight - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -10 - Font.Name = 'MS Sans Serif' - Font.Style = [] - OldCreateOrder = False - PixelsPerInch = 96 - TextHeight = 13 - object pb: TProgressBar - Left = 2 - Top = 2 - Width = 325 - Height = 20 - Smooth = True - TabOrder = 0 - end -end diff --git a/Threads.pas b/Threads.pas index c06d88e..d7daa69 100644 --- a/Threads.pas +++ b/Threads.pas @@ -26,7 +26,7 @@ TAnalyzeThread = class(TThread) Procedure UpdateBeforeClassViewer; Procedure StrapSysProcs; Procedure FindRTTIs; - Procedure FindVMTs2; //Для версии Дельфи2 (другая структура!) + Procedure FindVMTs2; //for Delphi2 (different structure!) Procedure FindVMTs; Procedure FindTypeFields; Function FindEvent(VmtAdr:Integer; Name:AnsiString):AnsiString; @@ -49,7 +49,7 @@ TAnalyzeThread = class(TThread) public all:Boolean; //if false, only ClassViewer ReturnValue:Integer; - Constructor Create(AForm:TFMain; AllValue:Boolean); + constructor Create(AForm:TFMain; AllValues:Boolean); end; Implementation @@ -80,12 +80,12 @@ StdUnitInfo = record ); -Constructor TAnalyzeThread.Create (AForm:TFMain; AllValue:Boolean); +constructor TAnalyzeThread.Create(AForm:TFMain; AllValues:Boolean); Begin Inherited Create(True); Priority:=tpLower; mainForm:=AForm; - all:=AllValue; + all:=AllValues; end; //PopupMenu items!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -224,12 +224,12 @@ StdUnitInfo = record Procedure TAnalyzeThread.UpdateProgress; Begin - PostMessage(mainForm.Handle, WM_UPDANALYSISSTATUS, Ord(taUpdatePrBar), 0); + if Not Terminated then PostMessage(mainForm.Handle, WM_UPDANALYSISSTATUS, Ord(taUpdatePrBar), 0); end; Procedure TAnalyzeThread.StopProgress; Begin - PostMessage(mainForm.Handle, WM_UPDANALYSISSTATUS, Ord(taStopPrBar), 0); + PostMessage(mainForm.Handle, WM_UPDANALYSISSTATUS, Ord(taUpdatePrBar), 0); //as the nice place to check if we are asked to Terminate if Terminated Then Raise Exception.Create('Termination request 1'); end; @@ -238,31 +238,38 @@ StdUnitInfo = record var updStatBar:PThreadAnalysisData; Begin - if Terminated then Raise Exception.Create('Termination request 2'); - New(updStatBar); - updStatBar.pbSteps:=0; - updStatBar.sbText:= Val2Str(adr,8); - SendMessage(mainForm.Handle, WM_UPDANALYSISSTATUS, Ord(taUpdateStBar), Integer(updStatBar)); + if not Terminated then + begin + New(updStatBar); + updStatBar.pbSteps:=0; + updStatBar.sbText:= Val2Str(adr,8); + SendMessage(mainForm.Handle, WM_UPDANALYSISSTATUS, Ord(taUpdateStBar), Integer(updStatBar)); + end; end; Procedure TAnalyzeThread.UpdateStatusBar(const sbText:AnsiString); var updStatBar:PThreadAnalysisData; Begin - if Terminated then Raise Exception.Create('Termination request 3'); - New(updStatBar); - updStatBar.pbSteps:=0; - updStatBar.sbText:= sbText; - SendMessage(mainForm.Handle, WM_UPDANALYSISSTATUS, Ord(taUpdateStBar), Integer(updStatBar)); + if not Terminated then + begin + New(updStatBar); + updStatBar.pbSteps:=0; + updStatBar.sbText:= sbText; + SendMessage(mainForm.Handle, WM_UPDANALYSISSTATUS, Ord(taUpdateStBar), Integer(updStatBar)); + end; end; Procedure TAnalyzeThread.UpdateAddrInStatusBar (adr:Integer); Begin - Inc(adrCnt); - if adrCnt = SKIPADDR_COUNT then + if not Terminated then begin - UpdateStatusBar(adr); - adrCnt := 0; + Inc(adrCnt); + if adrCnt = SKIPADDR_COUNT then + begin + UpdateStatusBar(adr); + adrCnt := 0; + end; end; end; @@ -2382,14 +2389,14 @@ StdUnitInfo = record if not KBase.IsUsedProc(Idx) then Begin matched := false; - if KBase.GetProcInfo(Idx, [INFO_DUMP], pInfo) and (pInfo.DumpSz >= 8) then + if KBase.GetProcInfo(Idx, [INFO_DUMP], pInfo) and (pInfo.DumpSz >= 8) and (m+pInfo.DumpSz < toPos) then Begin matched := MatchCode(Code + m, @pInfo) and mainForm.StrapCheck(m, @pInfo); if matched then Begin - //If method of class, check that ClassName is found - clasName := ExtractClassName(pInfo.ProcName); - if (clasName = '') or Assigned(GetOwnTypeByName(clasName)) then + //If method of class, check that ClassName is found - removed by Crypto + ///clasName := ExtractClassName(pInfo.ProcName); + ///if (clasName = '') or Assigned(GetOwnTypeByName(clasName)) then Begin recU.matchedPercent:=recU.matchedPercent + 100 * pInfo.DumpSz / (toPos - fromPos + 1); break; @@ -2485,13 +2492,13 @@ StdUnitInfo = record if not KBase.GetProcIdxs(moduleID, FirstProcIdx, LastProcIdx, DumpSize) then continue; stepMask := StartProgress(toPos - fromPos + 1, 'Scan Unit ' + unitName + ': step 1'); recU.kb := true; - lastMatchPos := 0; + ///lastMatchPos := 0; m:=fromPos; While m < toPos do Begin if Terminated then Break; if ((m-fromPos) and stepMask) = 0 then UpdateProgress; - if (lastMatchPos<>0) and (m > lastMatchPos + DumpSize) then break; + ///if (lastMatchPos<>0) and (m > lastMatchPos + DumpSize) then break; if Code[m]=#0 then Begin Inc(m); @@ -2518,17 +2525,18 @@ StdUnitInfo = record Idx := KBase.ProcOffsets[k].ModId; if not KBase.IsUsedProc(Idx) then Begin - if KBase.GetProcInfo(Idx, [INFO_DUMP, INFO_ARGS], pInfo) and (pInfo.DumpSz >= 8) then + if KBase.GetProcInfo(Idx, [INFO_DUMP, INFO_ARGS], pInfo) and (pInfo.DumpSz >= 8) + and (m + pInfo.DumpSz < toPos) then Begin //Check code matching matched := MatchCode(Code + m, @pInfo) and mainForm.StrapCheck(m, @pInfo); if matched then Begin - //If method of class, check that ClassName is found - clasName := ExtractClassName(pInfo.ProcName); - if (clasName = '') or Assigned(GetOwnTypeByName(clasName)) then + //If method of class, check that ClassName is found - removed by Crypto + ///clasName := ExtractClassName(pInfo.ProcName); + ///if (clasName = '') or Assigned(GetOwnTypeByName(clasName)) then Begin - if lastMatchPos=0 then lastMatchPos := m; + ///if lastMatchPos=0 then lastMatchPos := m; mainForm.StrapProc(m, Idx, @pInfo, true, pInfo.DumpSz); Inc(m, pInfo.DumpSz - 1); break; @@ -2651,14 +2659,15 @@ StdUnitInfo = record Idx := KBase.ProcOffsets[k].ModId; if not KBase.IsUsedProc(Idx) then Begin - if KBase.GetProcInfo(Idx, [INFO_DUMP, INFO_ARGS], pInfo) and (pInfo.DumpSz > 1) then + if KBase.GetProcInfo(Idx, [INFO_DUMP, INFO_ARGS], pInfo) and (pInfo.DumpSz >= 8) + and (m + pInfo.DumpSz < toPos) then Begin matched := MatchCode(Code + m, @pInfo) and mainForm.StrapCheck(m, @pInfo); if matched then Begin - //If method of class, check that ClassName is found - clasName := ExtractClassName(pInfo.ProcName); - if (clasName = '') or Assigned(GetOwnTypeByName(clasName)) then + //If method of class, check that ClassName is found - removed by Crypto + ///clasName := ExtractClassName(pInfo.ProcName); + ///if (clasName = '') or Assigned(GetOwnTypeByName(clasName)) then Begin mainForm.StrapProc(m, Idx, @pInfo, true, pInfo.DumpSz); break; @@ -2712,14 +2721,15 @@ StdUnitInfo = record if not KBase.IsUsedProc(Idx) then Begin matched := false; - if KBase.GetProcInfo(Idx, [INFO_DUMP], pInfo) and (pInfo.DumpSz > 1) then + if KBase.GetProcInfo(Idx, [INFO_DUMP], pInfo) and (pInfo.DumpSz >= 8) + and (m + pInfo.DumpSz < toPos) then Begin matched := MatchCode(Code + m, @pInfo) and mainForm.StrapCheck(m, @pInfo); if matched then Begin - //If method of class, check that ClassName is found - clasName := ExtractClassName(pInfo.ProcName); - if (clasName = '') or Assigned(GetOwnTypeByName(clasName)) then + //If method of class, check that ClassName is found - removed by Crypto + ///clasName := ExtractClassName(pInfo.ProcName); + ///if (clasName = '') or Assigned(GetOwnTypeByName(clasName)) then Begin recU.matchedPercent := recU.matchedPercent + 100 * pInfo.DumpSz / (toPos - fromPos + 1); break; @@ -2775,14 +2785,15 @@ StdUnitInfo = record if not KBase.IsUsedProc(Idx) then Begin matched := false; - if KBase.GetProcInfo(Idx, [INFO_DUMP, INFO_ARGS], pInfo) and (pInfo.DumpSz > 1) then + if KBase.GetProcInfo(Idx, [INFO_DUMP, INFO_ARGS], pInfo) and (pInfo.DumpSz >= 8) + and (m + pInfo.DumpSz < toPos) then Begin matched := MatchCode(Code + m, @pInfo) and mainForm.StrapCheck(m, @pInfo); if matched then Begin - //If method of class, check that ClassName is found - clasName := ExtractClassName(pInfo.ProcName); - if (clasName = '') or Assigned(GetOwnTypeByName(clasName)) then + //If method of class, check that ClassName is found - removed by Crypto + ///clasName := ExtractClassName(pInfo.ProcName); + ///if (clasName = '') or Assigned(GetOwnTypeByName(clasName)) then Begin mainForm.StrapProc(m, Idx, @pInfo, true, pInfo.DumpSz); StdUnits[r].used := true; @@ -3249,8 +3260,8 @@ StdUnitInfo = record Inc(i,4); continue; end; - len := lstrlenW(PWideChar(Code + i + 12)); - //len = *((int*)(Code + i + 8)); + //len := lstrlenW(PWideChar(Code + i + 12)); + len := PInteger(Code + i + 8)^; if (len <= 0) or (len > 10000) then begin Inc(i,4); @@ -3504,7 +3515,8 @@ StdUnitInfo = record Begin fieldOfs := getProc and $00FFFFFF; recN1 := GetInfoRec(classVMT + VmtSelfPtr); - recN1.vmtInfo.AddField(0, 0, FIELD_PUBLIC, fieldOfs, -1, _name, typeName); + If Assigned(recN1) and Assigned(recN.vmtInfo) then + recN1.vmtInfo.AddField(0, 0, FIELD_PUBLIC, fieldOfs, -1, _name, typeName); End else if (getProc and $FF000000) = $FE000000 then Begin @@ -3542,7 +3554,8 @@ StdUnitInfo = record Begin fieldOfs := setProc and $00FFFFFF; recN1 := GetInfoRec(classVMT + VmtSelfPtr); - recN1.vmtInfo.AddField(0, 0, FIELD_PUBLIC, fieldOfs, -1, _name, typeName); + If Assigned(recN1) and Assigned(recN.vmtInfo) then + recN1.vmtInfo.AddField(0, 0, FIELD_PUBLIC, fieldOfs, -1, _name, typeName); End else if (setProc and $FF000000) = $FE000000 then Begin @@ -3581,7 +3594,8 @@ StdUnitInfo = record Begin fieldOfs := storedProc and $00FFFFFF; recN1 := GetInfoRec(classVMT + VmtSelfPtr); - recN1.vmtInfo.AddField(0, 0, FIELD_PUBLIC, fieldOfs, -1, _name, typeName); + If Assigned(recN1) and Assigned(recN.vmtInfo) then + recN1.vmtInfo.AddField(0, 0, FIELD_PUBLIC, fieldOfs, -1, _name, typeName); End else if (storedProc and $FF000000) = $FE000000 then Begin diff --git a/TypeInfos.pas b/TypeInfos.pas index 5af215f..1ac6d13 100644 --- a/TypeInfos.pas +++ b/TypeInfos.pas @@ -782,11 +782,11 @@ implementation begin Size := PInteger(Code + _pos)^; Inc(_pos,4); + result := RTTIName + ' = record // size=' + Val2Str(Size); elNum := PInteger(Code + _pos)^; Inc(_pos,4); //FldCount if elNum<>0 then begin - result := RTTIName + ' = record // size=' + Val2Str(Size); for i:= 1 to elNum do begin typeAdr := PInteger(Code + _pos)^; @@ -808,7 +808,6 @@ result := RTTIName + ' = record // size=' + Val2Str(Size); Inc(_pos,4); //RecFldCnt if elNum<>0 then begin - result := RTTIName + ' = record // size=' + Val2Str(Size); for i := 1 to elNum do begin //TypeRef