Delphi programmeur gevraagd voor defiant.

Böllke · 24 februari 2003

Hoi

Ik wilde eens vragen of er niet onder jullie een goede Delphi software schrijver zit die ook nog een beetje spaans kan. Ik zoek namelijk iemand die een compiler kan inbouwen in het programma defiant 2.61 Voor de pioneer gebruikers is dit een wel bekend programma, voor alle anderen. Met dit programma kan het MHW van de pioneer en philips dozen (en nog een paar) bewerkt worden. Dit geweldige programma is van sa1vad0r. Helaas is deze spanjaard wegens een nieuwe wet in spanje mee gestopt.

Het probleem is dat het gedeelte voor het compileren van de *.cpi scripts nog niet geimplementeerd is. Hieronder het gedeelte van het programma waar het om gaat. Een ieder die mij kan helpen graag, wil iemand de complete listing dan ff een PM met je email adres.

Alvast bedank voor jullie reakties

Groetjes

Böllke

Hier de code:

unit MHWScript;

interface

uses

ComCtrls, MHWCLass, MHWPanel, SysUtils, Pack, stack, StrUtils, Classes, Dialogs, Main;

type

TMode = record

loopVar: String;

fromVal: String;

toVal: String;

len: String;

step: String;

end;

TMHWScript = class(TObject)

procedure GuardaDatos();

destructor Destroy; override;

private

{ Private declarations }

bufscript : PChar;

longscript : integer;

NomClases : array of string;

prevOp : array [0..1] of integer;

nodoscript : TTreeNode;

Panel : TMHWPanel;

nombre : string;

procedure replace_last(sWhat,sWith:string; var s:String);

function BorraEspacios(cadena : string):string;

function BuscaClase(nombre : string; NumClase : integer):boolean;

function NombreClase(nodo : TTreeNode):string;

function leecadena(buftemp : pchar; longitud : integer):string;

function ParseCPI(MostrarMensajes : boolean):boolean;

function BuscaWidget(metodo : integer):string;

public

{ Public declarations }

Clase : array of TMHWClass;

NomScript : string;

Resultado : boolean;

Lineas : TStrings;

constructor Crear(nodo : TTreeNode; MostrarMensajes : boolean);

published

property nodoAbierto : TTreeNode read nodoscript;

end;

implementation

constructor TMHWScript.Crear(nodo : TTreeNode; MostrarMensajes : boolean);

var

nodopanel : TTreeNode;

i : integer;

begin

inherited Create();

nodoscript := nodo;

bufscript := PChar(AllocMem((PDatosNodo(nodoscript.Data)^.Tamano*30) + 1));

for i:=0 to (PDatosNodo(nodoscript.Data)^.Tamano*30)-1 do bufscript := chr($0);

longscript := UnPackMHW(@PDatosNodo(nodoscript.Data)^.BufferDatos[0], bufscript, PDatosNodo(nodoscript.Data)^.Tamano);

Lineas := TStringList.Create;

nombre := copy(nodoscript.Text,1,pos('.',nodoscript.Text)-1);

nodopanel := Busca(nodoscript.Parent.getFirstChild, nombre+'.pa', False);

if nodopanel<>nil then

Panel := TMHWPanel.Crear(nodopanel);

resultado := (ParseCPI(MostrarMensajes));

end;

destructor TMHWScript.Destroy;

var

i : integer;

begin

if bufscript<>nil then FreeMem(bufscript);

if (Clase<>nil) then

for i:=0 to length(Clase)-1 do

if (Clase<>nil) then Clase.Destroy;

Finalize(Clase);

Finalize(NomClases);

Lineas.Free;

if Panel<>nil then Panel.Destroy;

inherited Destroy;

end;

procedure TMHWScript.GuardaDatos();

var

i : integer;

buftemp : PChar;

begin

buftemp := PChar(AllocMem(longscript+1));

for i:=0 to longscript-1 do

buftemp := bufscript;

// COMPILATION SHOULD BE HERE !!!!!

// Hier het gedeelte voor de compilatie!!!

FreeMem(@PDatosNodo(nodoscript.Data)^.BufferDatos[0]);

PDatosNodo(nodoscript.Data)^.BufferDatos := PChar(AllocMem((30 * longscript)+1));

for i:=0 to (30 * longscript)-1 do PDatosNodo(nodoscript.Data)^.BufferDatos := chr($0);

PDatosNodo(nodoscript.Data)^.Tamano := PackMHW(@buftemp[0], @PDatosNodo(nodoscript.Data)^.BufferDatos[0], longscript, 7);

for i:=PDatosNodo(nodoscript.Data)^.Tamano to (30 * longscript) do

PDatosNodo(nodoscript.Data)^.BufferDatos := chr(0);

FreeMem(buftemp);

end;

function TMHWScript.leecadena(buftemp : pchar; longitud : integer):string;

var

i : integer;

cadena : string;

begin

cadena := '';

i := 0;

while (i<longitud)and(ord(buftemp)<>0) do

begin

cadena := cadena + buftemp;

inc(i);

end;

leecadena := cadena;

end;

function TMHWScript.NombreClase(nodo : TTreeNode):string;

var

buftemp : PChar;

begin

buftemp := PChar(AllocMem((PDatosNodo(nodo.Data)^.Tamano*30) + 1));

UnPackMHW(@PDatosNodo(nodo.Data)^.BufferDatos[0], buftemp, PDatosNodo(nodo.Data)^.Tamano);

NombreClase := leecadena(@buftemp[$D+leeentero2(@buftemp[8],2)+1],leeentero2(@buftemp[$A],2));

FreeMem(buftemp);

end;

function TMHWScript.BuscaClase(nombre : string; NumClase : integer):boolean;

var

NodoTemp1, NodoTemp2, NodoTemp3 : TTreeNode;

tipo : string;

encontrado : boolean;

begin

encontrado := False;

// Buscamos en el mismo directorio

NodoTemp1 := nodoscript.Parent.getFirstChild;

while (NodoTemp1<>nil) and not(encontrado) do

begin

tipo := lowercase(copy(NodoTemp1.Text, length(NodoTemp1.Text)-3, 3));

if (tipo = '.cl')and(lowercase(nombre) = lowercase(NombreClase(NodoTemp1))) then

begin

encontrado := True;

Clase[NumClase] := TMHWClass.Crear(NodoTemp1);

end;

NodoTemp1 := NodoTemp1.getNextSibling;

end;

// Buscamos en 'basic'

if not(encontrado) then

begin

NodoTemp1 := MainForm.HETreeView1.Items.GetFirstNode.getFirstChild;

while (NodoTemp1<>nil) and (lowercase(NodoTemp1.Text)<>'basic') do

NodoTemp1 := NodoTemp1.getNextSibling;

if (NodoTemp1<>nil) then

begin

NodoTemp1 := NodoTemp1.getFirstChild;

while (NodoTemp1<>nil) and not(encontrado) do

begin

tipo := lowercase(copy(NodoTemp1.Text, length(NodoTemp1.Text)-3, 3));

if (tipo = '.cl')and(lowercase(nombre) = lowercase(NombreClase(NodoTemp1))) then

begin

encontrado := True;

Clase[NumClase] := TMHWClass.Crear(NodoTemp1);

end;

NodoTemp1 := NodoTemp1.getNextSibling;

end;

// Buscamos en 'commun'

if not(encontrado) then

begin

NodoTemp1 := MainForm.HETreeView1.Items.GetFirstNode.getFirstChild;

while (NodoTemp1<>nil) and (lowercase(NodoTemp1.Text)<>'commun') do

NodoTemp1 := NodoTemp1.getNextSibling;

if (NodoTemp1<>nil) then

begin

NodoTemp1 := NodoTemp1.getFirstChild;

while (NodoTemp1<>nil) and not(encontrado) do

begin

tipo := lowercase(copy(NodoTemp1.Text, length(NodoTemp1.Text)-3, 3));

if (tipo = '.cl')and(lowercase(nombre) = lowercase(NombreClase(NodoTemp1))) then

begin

encontrado := True;

Clase[NumClase] := TMHWClass.Crear(NodoTemp1);

end;

NodoTemp1 := NodoTemp1.getNextSibling;

end;

// Buscamos en todo el firmware

if not(encontrado) then

NodoTemp1 := MainForm.HETreeView1.Items.GetFirstNode.getFirstChild;

while (NodoTemp1<>nil)and not(encontrado) do

begin

NodoTemp2 := nil;

if NodoTemp1.HasChildren then

NodoTemp2 := NodoTemp1.getFirstChild;

while (NodoTemp2<>nil)and not(encontrado) do

begin

if NodoTemp2.HasChildren then

begin

NodoTemp3 := NodoTemp2.getFirstChild;

while (NodoTemp3<>nil)and not(encontrado) do

begin

tipo := lowercase(copy(NodoTemp3.Text, length(NodoTemp3.Text)-3, 3));

if (tipo = '.cl')and(lowercase(nombre) = lowercase(NombreClase(NodoTemp3))) then

begin

encontrado := True;

Clase[NumClase] := TMHWClass.Crear(NodoTemp3);

end;

NodoTemp3 := NodoTemp3.getNextSibling;

end;

end

else

begin

tipo := lowercase(copy(NodoTemp2.Text, length(NodoTemp2.Text)-3, 3));

if (tipo = '.cl')and(lowercase(nombre) = lowercase(NombreClase(NodoTemp2))) then

begin

encontrado := True;

Clase[NumClase] := TMHWClass.Crear(NodoTemp2);

end;

NodoTemp2 := NodoTemp2.getNextSibling;

end;

NodoTemp1 := NodoTemp1.getNextSibling;

end;

BuscaClase := encontrado;

end;

function TMHWScript.BorraEspacios(cadena : string):string;

var

i : integer;

begin

i := length(cadena);

while (i>0)and(cadena=' ') do dec(i);

BorraEspacios := copy(cadena,1,i);

end;

function TMHWScript.BuscaWidget(metodo : integer):string;

var

i : integer;

cadena : string;

begin

if (Panel<>nil) then

begin

cadena := ' - Used by : ';

if metodo=panel.entryPoint then

cadena := cadena + nombre + '.RefreshMethod, ';

if metodo=panel.entryPointItit then

cadena := cadena + nombre + '.InitializationMethod, ';

if metodo=panel.entryPointFin then

cadena := cadena + nombre + '.FinalizationMethod, ';

if length(panel.VElementos)>0 then

for i:=0 to length(panel.VElementos)-1 do

if panel.VElementos.pEntrada = metodo then

cadena := cadena + nombre + ':' + panel.VElementos.code + ' (' + inttostr(i) + '), ';

i := length(cadena);

if (cadena[i-1]=',') then

cadena := copy(cadena,1,i-2);

if (cadena[i-1]=':') then

cadena := ' - Method not used by any widget !!!!';

end

else

cadena := '';

BuscaWidget := cadena;

end;

procedure TMHWScript.replace_last(sWhat,sWith:string; var s:String);

var

n, i:Integer;

sTemp: String;

begin

n:=pos(sWhat,s);

sTemp:=s;

i:=0 ;

while n>0 do

begin

sTemp:=RightStr(sTemp, length(sTemp)- n);

i:=i+n;

n:=pos(sWhat,sTemp);

end;

Insert(sWith,s,i);

Delete(s,i+length(sWith),length(sWhat));

end;

function TMHWScript.ParseCPI(MostrarMensajes : boolean):boolean;

var

encontrado, bSkip : boolean;

i, j, k, m, g_offset, header_len, shift, OpCode : integer;

sOut, cadena, sPar, sFuncList, sLoopVar, sOutText, sLastMode : string;

eval_stk, loop_stack, mode_stack : TStringStack;

Op : TAsmInstr;

modIn, modOut : TMode;

lstLabels, LineasTemp : TStrings;

begin

NomScript := BorraEspacios(leecadena(@bufscript[2],16));

i := ord(bufscript[$12]);

SetLength(NomClases, i);

SetLength(Clase, i);

encontrado := True;

j := 0;

while (j<i)and(encontrado) do

begin

NomClases[j] := leecadena(@bufscript[$13+(j*18)],16);

encontrado := BuscaClase(NomClases[j], j);

if encontrado then

inc(j)

else

if MostrarMensajes then

MessageDlg(Traduccion[262]+NomClases[j]+Traduccion[263], mtError, [mbOK], 0)

else

Lineas.Add(Traduccion[262]+NomClases[j]+Traduccion[263]);

end;

if encontrado then

begin

eval_stk := TStringStack.Create ; // pila con parametros a evaluar

loop_stack := TStringStack.Create; // pila con condiciones de saltos

mode_stack := TStringStack.Create; // pila con los modos (bloque en donde se esta). posibles valores : 'loop' (for, do, while), 'if', 'else'

lstLabels := TStringList.Create; // cadenas con las etiquetas

LineasTemp := TStringList.Create;

for j:=0 to i-1 do

Lineas.Add('class '+NomClases[j]+';');

if i>0 then

Lineas.Add('');

Lineas.Add('script '+NomScript+'(){');

shift:=1;

g_offset:=$13+($12*i);

header_len:= g_offset - 1;

i:=0;

bSkip:=false;

repeat

OpCode := leeentero2(@bufscript[g_offset],2);

sPar:='';

sFuncList:='' ;

Op.name := AsmInst[OpCode].name;

Op.typ := AsmInst[OpCode].typ;

Op.par := AsmInst[OpCode].par;

Op.oplen := AsmInst[OpCode].oplen;

Op.parlen := AsmInst[OpCode].parlen;

Op.pop := AsmInst[OpCode].pop;

Op.peek := AsmInst[OpCode].peek;

Op.push := AsmInst[OpCode].push;

Op.modpop := AsmInst[OpCode].modpop;

Op.modpush := AsmInst[OpCode].modpush;

Op.comment := AsmInst[OpCode].comment;

Op.mnem := AsmInst[OpCode].mnem;

Op.shift := AsmInst[OpCode].shift;

Op.unknown := AsmInst[OpCode].unknown;

if Op.unknown and MostrarMensajes then

MessageDlg(Traduccion[341]+' '+inttohex(OpCode,4), mtError, [mbOK], 0);

if Op.typ='primary' then

begin

if Op.par='char' then

begin

j := leeentero2(@bufscript[g_offset+Op.oplen],2);

sPar:=leecadena(@bufscript[g_offset+Op.oplen+Op.parlen], j);

g_offset:=g_offset+Op.oplen+Op.parlen+length(sPar)+1; //trailing #0

//align to odd

if ((g_offset-1) mod 2) > 0 then g_offset:=g_offset+1;

//Replacing LF occurences

while pos(#10,sPar)>0 do

replace_last(#10,'\n',sPar);

sPar:='"'+sPar+'"';

end;

//align to 4 bytes

if (Op.par<>'char')and(Op.parlen>2)and(((g_offset - header_len + Op.oplen - 1) mod 4) > 0) then

Op.oplen:=Op.oplen+2;

//justify for real

if (Op.parlen=8) and (((g_offset - header_len + Op.oplen - 1) mod 8) > 0) then

Op.oplen:=Op.oplen+4;

if Op.par='int' then

begin

sPar:=IntToStr(leeentero3(@bufscript[g_offset+Op.oplen],Op.parlen));

g_offset:=g_offset+Op.oplen+Op.parlen;

end;

if Op.par='var' then

begin

j := leeentero2(@bufscript[g_offset+Op.oplen],2);

sLoopVar := NomClases[j]+'.';

k := leeentero2(@bufscript[g_offset+Op.oplen+2],2);

if k<clase[j].NumVars then

sLoopVar := sLoopVar+clase[j].variables[k].name

else

sLoopVar := sLoopVar+'UnknownVariable'+inttohex(k,4);

sPar := sLoopVar;

g_offset:=g_offset+Op.oplen+Op.parlen;

end;

if Op.typ='secondary' then

g_offset:=g_offset+Op.oplen;

if Op.typ='jump' then

begin

j := 1+leeentero3(@bufscript[g_offset+Op.oplen],Op.parlen);

sPar:='lbl_'+IntToStr(i+j);

if OpCode=$12 then

begin //extracting IF..ELSE expressions

if j=2 then

bSkip:=true

else

if (mode_stack.Peek(mode_stack)='if')or(sLastMode='if') then

begin

lstLabels.Add(RightStr(sPar,length(sPar)-4)); //Final of else clause

Op.mnem:='else';

end;

g_offset:=g_offset+Op.oplen+Op.parlen;

end;

if Op.typ='loop' then

begin

sPar:=IntToStr(leeentero3(@bufscript[g_offset+Op.oplen],Op.parlen));

g_offset:=g_offset+Op.oplen+Op.parlen;

end;

if Op.typ='function' then

begin

g_offset:=g_offset+Op.oplen;

if Op.par='int' then

begin

j := leeentero3(@bufscript[g_offset],Op.parlen);

if OpCode=$3 then

eval_stk.Push(eval_stk, inttohex(j,4));

sPar:=IntToStr(j);

g_offset:=g_offset+Op.parlen;

end;

if Op.mnem<>'' then //forming mnemonic description

begin

sFuncList:=Op.mnem;

if (Op.typ='jump') or (Op.typ='loop') then

sFuncList:=Op.mnem+' '+sPar;

if (Op.typ='primary') then

begin

case OpCode of

39,40,12,54: sFuncList:=sPar+Op.mnem;

41..53: sFuncList:=Op.mnem+sPar;

else sFuncList:=sPar+' '+Op.mnem;

end;

//Popping parameters

if Op.peek>0 then

sFuncList:=sFuncList+eval_stk.Peek(eval_stk);

if Op.pop>0 then

for j := 1 to Op.pop do

begin

sOut:= eval_stk.Pop(eval_stk);

if sOut='' then sOut:='ParamValue';

if Op.modpush > 0 then

begin //Pushing loop stack

loop_stack.Push(loop_stack,sOut);

dec(Op.modpush);

end;

if pos('#',sFuncList)>0 then

begin //filling arg list for known functions

if (OpCode=$D) then

begin

Insert(sOut,sFuncList,pos('#',sFuncList));

Delete(sFuncList,pos('#',sFuncList),1);

end

else

begin

Insert(sOut,sFuncList,LastDelimiter('#',sFuncList));

Delete(sFuncList,LastDelimiter('#',sFuncList),1);

if (OpCode=$3) then

sFuncList := sFuncList + BuscaWidget(hextoint(sOut));

end;

if (Op.pop=0) and (Op.typ='function') and (Op.unknown) then

begin //filling arg list for unknown functions

for j := 1 to eval_stk.Count do

sFuncList:= eval_stk.Pop(eval_stk)+', '+sFuncList;

sFuncList:=Op.name+'('+LeftStr(sFuncList,LastDelimiter(',',sFuncList)-1)+')';

end;

if OpCode=$10 then

begin

cadena := eval_stk.Pop(eval_stk);

if (eval_stk.Count>0) then

cadena := cadena + ', ';

for j := 1 to eval_stk.Count do

sFuncList := eval_stk.Pop(eval_stk)+', '+sFuncList;

sFuncList := Op.name+'('+cadena+LeftStr(sFuncList,LastDelimiter(',',sFuncList)-1)+')';

end;

//Building loop expression

if Op.typ='loop' then

while pos('$',sFuncList)> 0 do

begin //Writing loop variable

Insert(sLoopVar,sFuncList,LastDelimiter('$',sFuncList));

Delete(sFuncList,LastDelimiter('$',sFuncList),1);

end;

if (OpCode=$F) then //FOR loop

begin

modOut.loopVar := loop_stack.pop(loop_stack);

modOut.step := loop_stack.pop(loop_stack);

modOut.toVal := loop_stack.pop(loop_stack);

modOut.fromVal := loop_stack.pop(loop_stack);

cadena := modOut.loopVar+' = '+modOut.fromVal+'; '+

modOut.loopVar+' < '+modOut.toVal+'; '+

modOut.loopVar+' += '+modOut.step;

replace_last('<FOR>', cadena, sOutText);

replace_last('<LOOP>','{',sOutText);

sFuncList := '}';

mode_stack.Pop(mode_stack); //End of FOR loop

end;

if (OpCode=$22) then

begin

modOut.loopVar:=loop_stack.pop(loop_stack);

replace_last('<LOOP>','while '+modOut.loopVar+' {',sOutText);

sFuncList:='}';

mode_stack.Pop(mode_stack); //End of WHILE loop

end;

if (OpCode=$21) then

begin

modOut.loopVar:=loop_stack.pop(loop_stack);

replace_last('<LOOP>','do {',sOutText);

sFuncList:='} while ('+modOut.loopVar+')';

mode_stack.Pop(mode_stack); //End of UNTIL loop

end;

//Push values into stack

if Op.push >0 then

begin

if (Op.typ='primary') then

begin

case OpCode of

39..53: eval_stk.Push(eval_stk,sFuncList);

else eval_stk.Push(eval_stk,sPar);

end;

end

else

eval_stk.Push(eval_stk,sFuncList);

end;

//Building ABS() expessions

if ((OpCode=$6C)and(prevOp[0]=$16)and(prevOp[1]=$38)) then

eval_stk.Push(eval_stk,'abs('+eval_stk.Pop(eval_stk)+')');

if Op.shift<0 then dec(shift);

if (sFuncList='') or (op.push>0) then

bSkip:=true;

if Op.mnem='else' then

sFuncList:='else';

if ((Op.typ='function')or(Opcode in [$C, $11, $36, $9D..$9F, $A1]))and not(OpCode=$3) then

sFuncList := sFuncList + ';';

sOut:=sFuncList;

sFuncList:= stringofchar(' ',shift*2)+'/* '+sFuncList+' */' ;

//*********** Decompilation support code site*****************

//Building FOR expressions

if (OpCode=$1D) then

sOut:='for (<FOR>)';

if (OpCode=$1F) then

begin

sOut:='<LOOP>';

mode_stack.Push(mode_stack,'loop');

end;

//Building IF expressions

if OpCode=$13 then

begin

lstLabels.Add(RightStr(sOut,length(sOut)-LastDelimiter('_',sOut)));

sOut:='if ('+copy(sOut,pos('(',sOut)+1,LastDelimiter(')',sOut)-pos('(',sOut)-1)+') {';

mode_stack.Push(mode_stack,'if');

end;

sLastMode:='';

while lstLabels.IndexOf(IntToStr(i))>=0 do

begin

dec(shift);

sOutText:= sOutText+stringofchar(' ',shift*2)+'}'+#13+#10;

sLastMode:=mode_stack.Pop(mode_stack); //finalizing IF clauses

lstLabels.Delete(lstLabels.IndexOf(inttostr(i)));

end;

//Not output service operators

case OpCode of

2,6,14,20..28,30,32,35,37,38,41,42,45,47,55: bSkip:=true;

108: if ((OpCode=$6C)and(prevOp[0]=$16)and(prevOp[1]=$38)) then bSkip:=true;

end;

//Saving history

prevOp[1] := prevOp[0];

prevOp[0] := OpCode;

if not bSkip then

sOutText:= sOutText+stringofchar(' ',shift*2)+sOut+#13+#10

else

bSkip:=false;

//Building ELSE clause

if Op.mnem='else' then

begin

mode_stack.Push(mode_stack,'else');

if lstLabels.IndexOf(IntToStr(i))>=0 then

lstLabels.Delete(lstLabels.IndexOf(inttostr(i)));

sOutText:= sOutText+stringofchar(' ',shift*2)+'{'+#13+#10 ;

inc(shift);

end;

//Skipping next operation

if (OpCode=$1F) and (StrToInt(sPar)>0) then bSkip:=true;

if Op.shift>0 then inc(shift);

inc(i);

until ((OpCode=0)or(g_offset>=longscript));

while mode_stack.Count>0 do

begin

dec(shift);

sOutText:=sOutText+stringofchar(' ',shift*2)+'}'+#13+#10;

mode_stack.Pop(mode_stack);

end;

lstLabels.Free;

mode_stack.Free;

loop_stack.Free;

eval_stk.Free;

LineasTemp.SetText(PChar(sOutText));

Lineas.AddStrings(LineasTemp);

Lineas[Lineas.Count-1] := '}';

ParseCPI := True;

LineasTemp.Free;

end

else

ParseCPI := False;

end;

end.

Inloggen

Delphi programmeur gevraagd voor defiant.

Aanbevolen berichten

Böllke

Maak een account aan of log in om te reageren

Account aanmaken

Inloggen

Wie is er online 0 leden

Overig

Activiteit