unit decrypt;
interface
uses windows,common,gname,savefile,datas,disasm,disio,fileload,range,
     schedule,menus;
{
  >* This class adds some simple block decryption/encryption with file     *
  >* patching to Borg. By storing decryptors in blocks it is possible to   *
  >* reconstruct the file when it is saved to database and reloaded, even  *
  >* if some patches were applied to the file and some were not.           *
  >* Added in Borg 2.19                                                    *
  >* NB Any future general file patching will need to be included in this  *
  >* class and saved in a similar way. This opens up the way to decrypting *
  >* patching and reencrypting within Borg :)                              *
  >* Current decryptors are fairly simple, but when used in combination    *
  >* they are very powerful. The Xadd is a bit obscure, but could be       *
  >* simply modified as needed, and recompiled for some powerful routines. *
}
type
// decrypt types supported - add, sub, mul, xor
  dectype  =(decnull,decadd,decsub,decmul,decrot,decxor,decxadd);
// decrypt lengths - byte,word,dword,array
  ditemtype=(null,decbyte,decword,decdword,decarray);

// decrypters are held in an array - this array is saved when a database is saved
// and the list is reapplied on loading the file.
  pdeclist=^tdeclist;
  tdeclist=packed record
    dec_start:lptr;
    dec_end:lptr;
    typ:dectype;
    dlength:ditemtype;
    value:dword;
    addr:lptr;
    patch:bool;
    uid:dword;
  end;

  tdecrypt=class(tslist)
  private
    nextitemnum:dword;
  public
    constructor create;
    function add_decrypted(dstart,dend:lptr; t:dectype; ditem:ditemtype; val:dword; adr:lptr; patchedexe:boolean):dword;
    procedure process_dec(dec_id:dword);
    procedure process_reload(dec_id:dword);
    function savedb(sf:tsavefile):boolean;
    function loaddb(sf:tsavefile):boolean;
    procedure dialg;
    procedure exepatch(dec_id:dword);
  end;

var
  decrypter:tdecrypt;

implementation
var
  lastvalue,lastseg,lastoffset:array[0..20] of char;
const
  lastdec:dectype=decxor;
  lastditem:ditemtype=decbyte;
  patchexe:boolean=FALSE;
  loading_db:boolean=FALSE;

// compare function for decryptor                                        *
// - these are simply stored in uid order, the uid being increased each  *
//   time a new one is applied                                           *
function dec_comp_func(i,j:listitem):integer;
begin
  result:=-1;
  if pdeclist(i).uid=pdeclist(j).uid then result:=0 else
  if pdeclist(i).uid>pdeclist(j).uid then result:=1;
end;

procedure dec_del_func(i:listitem);
begin
   freemem(pdeclist(i));
end;

constructor tdecrypt.create;
begin
  setcomparefunc(dec_comp_func);
  setdelfunc(dec_del_func);
  nextitemnum:=1;
  lastvalue[0]:=#0;
  lastseg[0]:=#0;
  lastoffset[0]:=#0;
end;

// add_decrypted                                                         *
// - just adds another item to the decrypt list                          *
// - the decrypt list is simply a list of blocks and how they were       *
//   changed and whether the exe was patched                             *
// - the list is just to enable reconstruction of the state of the file  *
//   on saving and loading databases with decryptors which may or may    *
//   not have been saved to the exe file                                 *
function tdecrypt.add_decrypted(dstart,dend:lptr; t:dectype; ditem:ditemtype; val:dword; adr:lptr; patchedexe:boolean):dword;
var ndec:pdeclist;
begin
  ndec:=new(pdeclist);
  ndec.dec_start:=dstart;
  ndec.dec_end:=dend;
  ndec.typ:=t;
  ndec.dlength:=ditem;
  ndec.value:=val;
  ndec.addr:=adr;
  ndec.patch:=patchedexe;
  ndec.uid:=nextitemnum;
  inc(nextitemnum);
  addto(listitem(ndec));
  result:=ndec.uid;
end;

// process_dec                                                           *
// - this processes a decryptor given the uid, actually applying it to   *
//   the file in memory. If a block contains any disassembly then this   *
//   is also deleted.                                                    *
procedure tdecrypt.process_dec(dec_id:dword);
var
  fnd:tdeclist;
  patch:pdeclist;
  pseg,aseg:pdsegitem;
  cpos:lptr;
  plen,ctr:integer;
  doitval,lval,tval:dword;
begin
  fnd.uid:=dec_id;
  patch:=pdeclist(find(listitem(@fnd)));
  if patch=nil then exit;
  if patch.uid<>dec_id then exit;
  pseg:=dta.findseg(patch.dec_start);
  if pseg=nil then exit;
  ctr:=0;
  case patch.dlength of
   decbyte:  plen:=1;
   decword:  plen:=2;
   decdword: plen:=4;
   decarray:
    begin
      plen:=1;
      aseg:=dta.findseg(patch.addr);
      if aseg=nil then exit;
      ctr:=patch.addr.o-aseg.addr.o;
    end;
   else plen:=1;
  end;
  cpos:=patch.dec_start;
  lval:=patch.value;
  while leeq(cpos,patch.dec_end) do begin
    // check within seg, and move to the next seg if we arent
    while cpos.o>pseg.addr.o+(pseg.size-plen) do begin
      dta.nextseg(cpos);
      if cpos.s=0 then break;
      if gr(cpos,patch.dec_end) then break;
      pseg:=dta.findseg(cpos);
    end;
    if cpos.s=0 then break;
    if gr(cpos,patch.dec_end) then break;
    case plen of
     1: doitval:=byte(pseg.data[cpos.o-pseg.addr.o]);
     2: doitval:=pw(pseg.data[cpos.o-pseg.addr.o])^;
     4: doitval:=pd(pseg.data[cpos.o-pseg.addr.o])^;
    end;
    if patch.dlength=decarray then begin
      if ctr+plen>aseg.size then break;
      case plen of
       1: patch.value:=byte(aseg.data[ctr]);
       2: patch.value:=pw(aseg.data[ctr])^;
       4: patch.value:=pd(aseg.data[ctr])^;
      end;
    end;
    case patch.typ of
     decxor: doitval:=doitval xor patch.value;
     decmul: doitval:=doitval * patch.value;
     decadd: doitval:=doitval + patch.value;
     decsub: doitval:=doitval - patch.value;
     decxadd:
      begin
        tval:=doitval;
        doitval:=lval;
        lval:=tval;
        doitval:=doitval+lval;
       end;
     decrot:
        case plen of
         1: doitval:=doitval shl (patch.value and $07) + (doitval shr (8 -(patch.value and $07)));
         2: doitval:=doitval shl (patch.value and $0f) + (doitval shr (16-(patch.value and $0f)));
         4: doitval:=doitval shl (patch.value and $1f) + (doitval shr (32-(patch.value and $1f)));
        end;
    end;
    case plen of
     1: byte(pseg.data[cpos.o-pseg.addr.o]):=byte(doitval);
     2: pw(pseg.data[cpos.o-pseg.addr.o])^:=word(doitval);
     4: pd(pseg.data[cpos.o-pseg.addr.o])^:=doitval;
    end;
    inc(cpos.o,plen);
    inc(ctr,plen);
  end;
  if not loading_db then dsm.undefineblock(patch.dec_start,patch.dec_end);
  dio.updatewindowifwithinrange(patch.dec_start,patch.dec_end);
end;

// exepatch                                                              *
// - given a uid this steps through a decryptor and writes the patch to  *
//   the exe file.                                                       *
procedure tdecrypt.exepatch(dec_id:dword);
var
  fnd:tdeclist;
  patch:pdeclist;
  pseg:pdsegitem;
  cpos:lptr;
  plen:integer;
  doitval:dword;
begin
  fnd.uid:=dec_id;
  patch:=pdeclist(find(listitem(@fnd)));
  if patch=nil then exit;
  if patch.uid<>dec_id then exit;
  pseg:=dta.findseg(patch.dec_start);
  case patch.dlength of
   decbyte:  plen:=1;
   decword:  plen:=2;
   decdword: plen:=4;
   decarray: plen:=1;
   else      plen:=1;
  end;
  cpos:=patch.dec_start;
  while leeq(cpos,patch.dec_end) do begin
    // check within seg, and move to the next seg if we arent
    while cpos.o>pseg.addr.o+(pseg.size-plen) do begin
      dta.nextseg(cpos);
      if cpos.s=0 then break;
      if gr(cpos,patch.dec_end) then break;
      pseg:=dta.findseg(cpos);
    end;
    if cpos.s=0 then break;
    if gr(cpos,patch.dec_end) then break;
    doitval:=floader.fileoffset(cpos);
    // write patch
    case plen of
     1:   floader.patchfile(doitval,1,pseg.data+(cpos.o-pseg.addr.o));
     2:   floader.patchfile(doitval,2,pseg.data+(cpos.o-pseg.addr.o));
     4:   floader.patchfile(doitval,4,pseg.data+(cpos.o-pseg.addr.o));
     else floader.patchfile(doitval,1,pseg.data+(cpos.o-pseg.addr.o));
    end;
    inc(cpos.o,plen);
  end;
end;

// process_reload                                                        *
// - given a uid this steps through a patch a re-reads the bytes in that *
//   would have been changed. This is used in file reconstruction        *
procedure tdecrypt.process_reload(dec_id:dword);
var
  fnd:tdeclist;
  patch:pdeclist;
  pseg:pdsegitem;
  cpos:lptr;
  plen:integer;
  doitval:dword;
begin
  fnd.uid:=dec_id;
  patch:=pdeclist(find(listitem(@fnd)));
  if patch=nil then exit;
  if patch.uid<>dec_id then exit;
  pseg:=dta.findseg(patch.dec_start);
  case patch.dlength of
   decbyte:  plen:=1;
   decword:  plen:=2;
   decdword: plen:=4;
   decarray: plen:=1;
   else      plen:=1;
  end;
  cpos:=patch.dec_start;
  while leeq(cpos,patch.dec_end) do begin
    // check within seg, and move to the next seg if we arent
    while cpos.o>pseg.addr.o+(pseg.size-plen) do begin
      dta.nextseg(cpos);
      if cpos.s=0 then break;
      if gr(cpos,patch.dec_end) then break;
      pseg:=dta.findseg(cpos);
    end;
    if cpos.s=0 then break;
    if gr(cpos,patch.dec_end) then break;
    doitval:=floader.fileoffset(cpos);
    // write patch
    case plen of
     1:   floader.reloadfile(doitval,1,pseg.data+(cpos.o-pseg.addr.o));
     2:   floader.reloadfile(doitval,2,pseg.data+(cpos.o-pseg.addr.o));
     4:   floader.reloadfile(doitval,4,pseg.data+(cpos.o-pseg.addr.o));
     else floader.reloadfile(doitval,1,pseg.data+(cpos.o-pseg.addr.o));
    end;
    inc(cpos.o,plen);
  end;
end;

// savedb                                                                *
// - this saves the list of decryptors to the database                   *
function tdecrypt.savedb(sf:tsavefile):boolean;
var
  ndecs:dword;
  currdec:pdeclist;
begin
  result:=false;
  ndecs:=numlistitems;
  resetiterator;
  if not sf.swrite(@ndecs,sizeof(dword)) then exit;
  while ndecs<>0 do begin
    currdec:=pdeclist(nextiterator);
    if not sf.swrite(@currdec,sizeof(tdeclist)) then exit;
    dec(ndecs);
  end;
  result:=true;
end;

// loaddb                                                                *
// - here we reload the list of decryptors and apply each to the file in *
//   memory. If we find a decryptor which was saved to disk then we      *
//   reload that block from the exe file. In this way after all of the   *
//   decryptors have been loaded we have synchronised the file in memory *
//   to the file on disk, plus any further patches made but not written  *
//   to disk. [Any byte in the file was synchronised to the file at the  *
//   time of the last patch which was written to file. Subsequent        *
//   patches have been made to memory only, and are just redone. So the  *
//   loaded file is in the same state as when the database was saved]    *
function tdecrypt.loaddb(sf:tsavefile):boolean;
var
  ndecs:dword;
  num:integer;
  currdec:pdeclist;
begin
  result:=false;
  if not sf.sread(@ndecs,sizeof(dword),num) then exit;
  while ndecs<>0 do begin
    currdec:=new(pdeclist);
    if not sf.sread(@currdec,sizeof(tdeclist),num) then exit;
    addto(listitem(currdec));
    nextitemnum:=currdec.uid+1;
    loading_db:=TRUE;
    if not currdec.patch then process_dec(currdec.uid)
    else process_reload(currdec.uid);
    loading_db:=FALSE;
    dec(ndecs);
  end;
  result:=true;
end;

// decbox                                                                *
// - the decryptor dialog, it only allows patching if the file is not    *
//   readonly, and adds the decryptor to the list and calls the process  *
//   and patch functions.                                                *
function decbox(hdwnd:HWND; msg,wParam,lParam:dword):dword;stdcall;
const brush:HBRUSH=0;
var
  drect:tRECT;
  dec_id:dword;
  d_val:dword;
  d_adr:lptr;
begin
  result:=0;
  case msg of
   WM_COMMAND:
    case wParam of
     IDOK:
      begin
        if SendDlgItemMessage(hdwnd,idc_xor,BM_GETCHECK,0,0)<>0 then lastdec:=decxor else
        if SendDlgItemMessage(hdwnd,idc_mul,BM_GETCHECK,0,0)<>0 then lastdec:=decmul;
        if SendDlgItemMessage(hdwnd,idc_add,BM_GETCHECK,0,0)<>0 then lastdec:=decadd else
        if SendDlgItemMessage(hdwnd,idc_sub,BM_GETCHECK,0,0)<>0 then lastdec:=decsub else
        if SendDlgItemMessage(hdwnd,idc_rot,BM_GETCHECK,0,0)<>0 then lastdec:=decrot else
        if SendDlgItemMessage(hdwnd,idc_xadd,BM_GETCHECK,0,0)<>0 then lastdec:=decxadd
        else lastdec:=decnull;
        if SendDlgItemMessage(hdwnd,idc_byte,BM_GETCHECK,0,0)<>0 then lastditem:=decbyte else
        if SendDlgItemMessage(hdwnd,idc_word,BM_GETCHECK,0,0)<>0 then lastditem:=decword else
        if SendDlgItemMessage(hdwnd,idc_dword,BM_GETCHECK,0,0)<>0 then lastditem:=decdword else
        if SendDlgItemMessage(hdwnd,idc_array,BM_GETCHECK,0,0)<>0 then lastditem:=decarray
        else lastditem:=decbyte;
        SendDlgItemMessage(hdwnd,idc_value,WM_GETTEXT,18,dword(@lastvalue));
        SendDlgItemMessage(hdwnd,idc_arrayseg,WM_GETTEXT,18,dword(@lastseg));
        SendDlgItemMessage(hdwnd,idc_arrayoffset,WM_GETTEXT,18,dword(@lastoffset));
        if IsDlgButtonChecked(hdwnd,idc_applytoexe)<>0 then patchexe:=TRUE
        else patchexe:=FALSE;
{$IFDEF VIRTUALPASCAL}
        wvsprintf(lastvalue,'%lx',d_val);
        wvsprintf(lastseg,'%lx',d_adr.s);
        wvsprintf(lastoffset,'%lx',d_adr.o);
{$ELSE}
        wvsprintf(lastvalue,'%lx',@d_val);
        wvsprintf(lastseg,'%lx',@d_adr.s);
        wvsprintf(lastoffset,'%lx',@d_adr.o);
{$ENDIF}
        patchexe:=FALSE;
        MessageBox(mainwindow,'File opened readonly - unable to patch','Borg Message',MB_OK);
        dec_id:=decrypter.add_decrypted(blk.top,blk.bottom,lastdec,lastditem,d_val,d_adr,patchexe);
        decrypter.process_dec(dec_id);
        if patchexe then decrypter.exepatch(dec_id);
        EndDialog(hdwnd,0);
      end;
     IDCANCEL: EndDialog(hdwnd,0);
    end;
   WM_INITDIALOG:
    begin
      GetWindowRect(hdwnd,drect);
      MoveWindow(hdwnd,((mainwnd.right+mainwnd.left)-(drect.right-drect.left)) div 2,
        ((mainwnd.bottom+mainwnd.top)-(drect.bottom-drect.top)) div 2,drect.right-drect.left,drect.bottom-drect.top,TRUE);
      brush:=CreateSolidBrush(GetSysColor(COLOR_BTNFACE));
      case lastdec of
       decxor: SendDlgItemMessage(hdwnd,idc_xor,BM_SETCHECK,1,0);
       decmul: SendDlgItemMessage(hdwnd,idc_mul,BM_SETCHECK,1,0);
       decadd: SendDlgItemMessage(hdwnd,idc_add,BM_SETCHECK,1,0);
       decsub: SendDlgItemMessage(hdwnd,idc_sub,BM_SETCHECK,1,0);
       decrot: SendDlgItemMessage(hdwnd,idc_rot,BM_SETCHECK,1,0);
       decxadd:SendDlgItemMessage(hdwnd,idc_xadd,BM_SETCHECK,1,0);
       else    SendDlgItemMessage(hdwnd,idc_xor,BM_SETCHECK,1,0);
      end;
      case lastditem of
       decbyte: SendDlgItemMessage(hdwnd,idc_byte,BM_SETCHECK,1,0);
       decword: SendDlgItemMessage(hdwnd,idc_word,BM_SETCHECK,1,0);
       decdword:SendDlgItemMessage(hdwnd,idc_dword,BM_SETCHECK,1,0);
       decarray:SendDlgItemMessage(hdwnd,idc_array,BM_SETCHECK,1,0);
       else     SendDlgItemMessage(hdwnd,idc_byte,BM_SETCHECK,1,0);
      end;
      SendDlgItemMessage(hdwnd,idc_value,WM_SETTEXT,0,dword(@lastvalue));
      SendDlgItemMessage(hdwnd,idc_arrayseg,WM_SETTEXT,0,dword(@lastseg));
      SendDlgItemMessage(hdwnd,idc_arrayoffset,WM_SETTEXT,0,dword(@lastoffset));
      CheckDlgButton(hdwnd,idc_applytoexe,dword(patchexe));
      SetFocus(GetDlgItem(hdwnd,idc_value));
      exit;
    end;
   WM_DESTROY: DeleteObject(brush);
   WM_CTLCOLORSTATIC, WM_CTLCOLORBTN, WM_CTLCOLORDLG, WM_SYSCOLORCHANGE:
    begin
      SetBkColor(HDC(wParam),GetSysColor(COLOR_BTNFACE));
      result:=brush;
    end;
  end;
end;


// - we stop the thread whilst displaying the decryptor dialog and doing *
//   the patch                                                           *
procedure tdecrypt.dialg;
begin
  if not blk.checkblock then exit;
  scheduler.stopthread;
  DialogBox(Inst,MAKEINTRESOURCE(Decrypt_Dialog),mainwindow,@decbox);
  scheduler.continuethread;
end;

initialization
  decrypter:=tdecrypt.create;
finalization
  decrypter.free;
end.

